→ The Lansweeper Customer Excellence Awards 2024 - Submit Your Project Now! Learn More & Enter Here
‎11-24-2021 07:09 PM - last edited on ‎04-01-2024 04:12 PM by Mercedes_O
Add the following action to user asset pages:
{actionpath}CSV_download.vbs "{username}"
And then this is the content of CSV_download.vbs
uName = WScript.Arguments(0)
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootLDAP = GetObject("LDAP://RootDSE")
'Define Constant and declare variables
Const ADS_UF_ACCOUNTDISABLE = &H02
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_LOCKOUT = &H10
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const SEC_IN_DAY = 86400
acctdisable = "Enabled"
acctlocked = "Not Locked"
'Setup ADODB connection
clicked = 1
Set con = CreateObject("ADODB.Connection")
If clicked = 1 Then
objShell.SendKeys "{ENTER}"
clicked = 0
End If
Set com = CreateObject("ADODB.Command")
dcName = objRootLDAP.Get("DefaultNamingContext")
DomainN = Replace(Replace(dcName,",DC=","."),"DC=","")
con.Provider = "ADsDSOObject"
con.Open "Active Directory Provider"
Set com.ActiveConnection = con
com.Properties("Searchscope") = 2
com.CommandText = "select sAMAccountName,distinguishedName,givenName,sn,UserAccountControl,CN,l,mail,Department,telephoneNumber,Title,manager,adspath,employeeid,memberof,primaryGroupId from 'LDAP://" & dcName & "' WHERE samAccountName = '" & uName & "' and objectclass = 'USER'"
Set rs = com.Execute
com.CommandText = "<LDAP://" & dcName & ">" & ";(&(objectClass=user)(mail=*)(samaccountname=" & uName & "))" & ";distinguishedName,displayName,mail,proxyAddresses;subtree"
Set objRecordSet = com.Execute
'get proxy emails
While Not objRecordSet.EOF 'Iterate through the search results
strUserDN = objRecordSet.Fields("distinguishedName") 'Get User's distinguished name from Recordset into a string
set objUser= GetObject("LDAP://"& strUserDN & "") 'Use string to bind to user object
strResult = strResult & objUser.mail & "; "
arrProxyAddresses = objRecordSet.Fields("proxyAddresses")
If IsArray(objRecordSet.Fields("proxyAddresses")) Then
For Each ProxyAddress in arrProxyAddresses
proxy_parts = Split(ProxyAddress,":")
If InStr(objUser.mail, proxy_parts(1)) Then
' skip since mail email is also a proxy
Else
If InStr(proxy_parts(1), "@") Then
'Sub: Check X400
If InStr(ProxyAddress, "x400") Then
'Sub: Check X500
ElseIf InStr(ProxyAddress, "x500") Then
Else
strResult = strResult & proxy_parts(1) & "; "
AddressCount = AddressCount + 1
End If 'Ends loop for X400 address
Else
' not an email address
End If 'Ends loop for InStr(proxy_parts(1), "@")
End If 'Ends loop for InStr(objUser.mail, proxy_parts(1))
Next
Else
strResult = strResult & "#Object does not have proxy addresses"
End If
strResult = strResult
objRecordSet.MoveNext
Wend 'End while loop second query for users
If Len(strResult) > 0 Then
' remove whitespace
strResult = Trim(strResult)
' remove last character
strResult = Left(strResult, Len(strResult) - 1)
End If
proxyemail = strResult
' get sid
On Error Resume Next
Set WMIUser = GetObject("winmgmts:{impersonationlevel=impersonate}!" & "/root/cimv2:Win32_UserAccount.Domain='" & Split(DomainN,".")(0) & "'" & ",Name='" & rs("sAMAccountName") & "'")
If Err.Number = 0 Then
sid_result = WMIUser.SID
Else
sid_result = ""
End If
On Error GoTo 0
' get lastlogon
Set objUser=GetObject(rs("adspath"))
Set objLogon=objUser.Get("lastlogon")
intLogonTime = objLogon.HighPart * (2^32) + objLogon.LowPart
LastLogon = Integer8Date(intLogonTime, lngBias)
u_proxyemails = proxyemail
u_sid = sid_result
u_adspath = rs("adspath")
u_primaryGroupId = rs("primaryGroupId")
u_memberof = GetMemberOf(uName)
u_sAMAccountName = rs("sAMAccountName")
u_distinguishedName = rs("distinguishedName")
u_givenName = rs("givenName")
u_sn = rs("sn")
u_UserAccountControl = rs("UserAccountControl")
u_CN = rs("CN")
u_l = rs("l")
u_mail = rs("mail")
u_Department = rs("Department")
u_telephoneNumber = rs("telephoneNumber")
u_Title = rs("Title")
u_manager = rs("manager")
u_employeeid = rs("employeeid")
u_sidhistory = GetUserSidHistory(uName)
u_lastLogon = LastLogon
intFlag = u_UserAccountControl
lngFlag = u_UserAccountControl
Set objUser = GetObject("LDAP://" & u_distinguishedName & "")
intUAC = u_UserAccountControl
dtmValue = objUser.PasswordLastChanged
intTimeInterval = int(Now - dtmValue)
Set objDomainNT = GetObject("WinNT://" & DomainN)
ntMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
intMaxPwdAge = (ntMaxPwdAge/SEC_IN_DAY)
If intFlag And ADS_UF_DONT_EXPIRE_PASSWD Then
PWEXP = "Never"
Else
PWEXP = (dtmValue + intMaxPwdAge)
End If
u_pwexpires = PWEXP
Call MakeCSV()
'*****************************************************************************************
' FUNCTIONS
'*****************************************************************************************
Function GetMemberOf(strUserName)
dim temp,d,returnstr,objNetwork
Set d = CreateObject("Scripting.Dictionary")
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_1779 = 1
Const ADS_NAME_INITTYPE_SERVER = 2
Const ADS_NAME_INITTYPE_DOMAIN = 1
strUserDomain_tmp = DomainN
strUserDomain = Split(strUserDomain_tmp,".")(0)
Set objUser = GetObject("WinNT://" & strUserDomain & "/" & strUserName & ",user")
strGroupList = ""
For Each objGroup In objUser.Groups
strGroupName=objGroup.Name
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_DOMAIN, strUserDomain
strNTName = strUserDomain & "\" & strGroupName
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
' Escape any forward slash characters, "/", with the backslash
' escape character. All other characters that should be escaped are.
strGroupDN = Replace(strGroupDN, "/", "\/")
Set objGroup = GetObject("LDAP://" & strGroupDN)
' format OU path for display
oupath = Mid(strGroupDN,Len(Trim(objGroup.CN))+5)
oupath = Replace(oupath,"CN=","")
oupath = Replace(oupath,"OU=","")
oupath = Replace(oupath, ",DC=", "/",1,1)
oupath = Replace(oupath, ",DC=", ".")
returnstr = returnstr & objGroup.CN & " (" & oupath & "); "
returnstr = returnstr & GetNested (objGroup)
Next
GetMemberOf = returnstr
End Function
'*****************************************************************************************
Function GetNested(objGroup)
On Error Resume Next
colMembers = objGroup.GetEx("memberOf")
For Each strMember in colMembers
strPath = "LDAP://" & strMember
Set objNestedGroup = GetObject(strPath)
strGroupList = objNestedGroup.CN
if strGroupList <> "" and temp <> strGroupList then
temp=strGroupList
strGroupList=trim(strGroupList)
d.add strGroupList
' format OU path for display
oupath = Mid(strMember,Len(Trim(strGroupList))+5)
oupath = Replace(oupath,"CN=","")
oupath = Replace(oupath,"OU=","")
oupath = Replace(oupath, ",DC=", "/",1,1)
oupath = Replace(oupath, ",DC=", ".")
returnstr = returnstr & strGroupList & " (" & oupath & "); "
End If
GetNested(objNestedGroup)
Next
GetNested = returnstr
End Function
'*****************************************************************************************
Function GetUserSidHistory(UsrName)
Dim tDomain,cmd,shell,executor,ps1result,regSidHist
tDomain = DomainN
strResult = ""
cmd = "powershell.exe -nologo -windowstyle hidden -command ""Get-AdUser -Server "& tDomain &" -Identity "& UsrName &" -Properties sidhistory"""
Set shell = CreateObject("WScript.Shell")
Set executor = shell.Exec(cmd)
executor.StdIn.Close
ps1result = executor.StdOut.ReadAll
strResult = Trim(ps1result)
' format result
strResult = Split(strResult, "SIDHistory :")(1)
strResult = Split(strResult, "Surname :")(0)
Set shell = Nothing
GetUserSidHistory = strResult
End Function
'*****************************************************************************************
Function MakeCSV()
Const ForWriting = 2
dt=now
dt_format = ((year(dt)*100 + month(dt))*100 + day(dt))
' get user
sUserIDValue = uName
' format domain
strSubDomain = Split(DomainN,".")(0)
' get csv value data
sidhist = Trim(Replace(Replace(u_sidhistory,"}",";"),"{",""))
uMembersof = u_memberof
userSMTP = u_proxyemails
userSID = u_sid
userDept = u_Department
userTitle = u_Title
userEmail = u_mail
userFname = u_givenName
userLname = u_sn
userPWexpire = u_pwexpires
userLastLogon = u_lastLogon
' get desktop path of user
strDirectory = objShell.SpecialFolders("Desktop")
' Create new CSV file
csvFilePath = strDirectory & "\" & dt_format & "-" & sUserIDValue & "-" & strSubDomain & ".csv"
If (objFSO.FileExists(csvFilePath)) Then
MsgBox "This file already exists: " & vbCrLf & csvFilePath,0,"Error"
Exit Function
Else
objFSO.CreateTextFile(csvFilePath)
Set objCSVFile = objFSO.OpenTextFile(csvFilePath,ForWriting,True)
End If
' Write comma delimited list of columns in new CSV file.
csvColumns = "Name,Department,Display Name,Email Address,All SMTP Addresses,Group Membership (All),Job Title,Last Logon Date,Password Expiration Date,SID,SID history,Username"
objCSVFile.Write csvColumns
objCSVFile.WriteLine
' Write values as comma-separated in new CSV file.
'For i = 0 to 1
'Name
objCSVFile.Write chr(34) & userFname & " " & userLname & chr(34) & ","
'Department
objCSVFile.Write chr(34) & userDept & chr(34) & ","
'Display Name
objCSVFile.Write chr(34) & userLname & ", " & userFname & chr(34) & ","
'Email Address
objCSVFile.Write chr(34) & userEmail & chr(34) & ","
'All SMTP Email Address
objCSVFile.Write chr(34) & userSMTP & chr(34) & ","
'Group membership
objCSVFile.Write chr(34) & uMembersof & chr(34) & ","
'Job title
objCSVFile.Write chr(34) & userTitle & chr(34) & ","
'Last logon date
objCSVFile.Write chr(34) & userLastLogon & chr(34) & ","
'logon DC
'objCSVFile.Write chr(34) & strSubDomain & chr(34) & ","
'Password exp date
objCSVFile.Write chr(34) & userPWexpire & chr(34) & ","
'SID
objCSVFile.Write chr(34) & userSID & chr(34) & ","
'SID History
objCSVFile.Write chr(34) & sidhist & chr(34) & ","
'Username
objCSVFile.Write chr(34) & u_sAMAccountName & chr(34) & ""
objCSVFile.Writeline
'Next
If (objFSO.FileExists(csvFilePath)) Then
MsgBox "CSV Export completed. File saved to: " & vbCrLf & csvFilePath,0,"Success"
End If
End function
'*****************************************************************************************
Function Integer8Date(ByVal lngValue, ByVal lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngDate
lngDate = #1/1/1601# + (lngValue/600000000 - lngBias)/1440
' Trap error if lngDate is ridiculously huge.
On Error Resume Next
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0
End Function
'*****************************************************************************************
Experience Lansweeper with your own data. Sign up now for a 14-day free trial.
Try Now