AD Group Membership Outputs and Account Status via e-mail
I'm having an issue. The report is generating fine however it is showing some of the user accounts in the report are disabled when they aren't. Is there a more efficient method to determine if the user account is disabled.
ALSO,
I can not get groups that have a space (i.e. Domain Admins) to add in to the StrGroup I defined.
Please someone help me.
GroupMembership-Check-and-Email.vbs
ALSO,
I can not get groups that have a space (i.e. Domain Admins) to add in to the StrGroup I defined.
Please someone help me.
GroupMembership-Check-and-Email.vbs
Last Comment
Hi, I haven't had time to review your code properly, but I've added the better way to check for the status of the account.
Regards,
Rob.
Regards,
Rob.
strScanGroups = "Admins,Management,Staff"
strSMTPRelay = "xxxxx"
strFrom = "xxxxx"
strTo = "xxxxxx"
Dim rootDSE, domainObject, adDomain, mailDomain
Set rootDSE = GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set domainObject = GetObject("LDAP://" & domainContainer)
Set fs = CreateObject ("Scripting.FileSystemObject")
Set outFile = fs.CreateTextFile (".\AdminGroupReport.txt")
arrGroups = Split(strScanGroups, ",")
strPad = " "
scanDomain(domainObject)
outFile.Close
Const ADS_UF_ACCOUNTDISABLE = 2
strTextBody = "Attached is the report listing members in key admin groups." & vbCRLF & vbCRLF & vbCRLF
strTextBody = strTextBody & "These groups include: " & vbCRLF & vbCRLF
For x = 0 to UBound(arrGroups)
strTextBody = strTextBody & arrGroups(x) & vbCRLF
Next
Set objMessage = CreateObject("CDO.Message")
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Subject = "Admin User Report for " & Now()
objMessage.From = strFrom
objMessage.To = strTo
objMessage.TextBody = strTextBody
objMessage.AddAttachment Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "AdminGroupReport.txt"
objMessage.Send
Wscript.Echo "Done!"
Sub scanDomain(oObject)
Dim oAD
For Each oAD in oObject
Select Case oAD.Class
Case "group"
For x = 0 to UBound(arrGroups)
If UCase(arrGroups(x)) = UCase(oAD.sAMAccountName) or arrGroups(x) = "*" then
outFile.WriteLine
outFile.WriteLine "----------------------------------------------------------------------------------------------------------"
outFile.WriteLine "Group: " & Replace(oAD.Name, "CN=" ,"")
oAD.GetInfo
On Error Resume Next
arrMemberOf = oAD.GetEx("member")
If Err.Number = 0 then
Err.Clear
For Each strMember in arrMemberOf
Set oUser = GetObject("LDAP://" & strMember)
If Err.Number <> 0 Then
outFile.WriteLine " " & strMember & Left(strPad, 80 - Len(strMember)) & "User Status Unknown"
Err.Clear
Else
'If oUser.AccountDisabled = TRUE then
' strStatus = "Account Disabled"
'Else
' strStatus = ""
'End If
intUAC=oUser.Get("userAccountControl")
If intUAC And ADS_UF_ACCOUNTDISABLE Then
strStatus = "Account Disabled"
Else
strStatus = ""
End If
outFile.WriteLine " " & oUser.sAMAccountName & Left(strPad, 40 - Len(oUser.sAMAccountName)) & oUser.displayName & Left(strPad, 40 - Len(oUser.displayName)) & strStatus
End If
Next
Else
Err.Clear
End If
On Error Goto 0
End If
Next
Case "organizationalUnit"
scanDomain(oAD)
Case "container"
scanDomain(oAD)
End Select
Next
End Sub
Also, for the groups with spaces issue, try changing this:
If UCase(arrGroups(x)) = UCase(oAD.sAMAccountName) or arrGroups(x) = "*" Then
to this
If UCase(arrGroups(x)) = UCase(oAD.DisplayName) or UCase(arrGroups(x)) = UCase(oAD.sAMAccountName) or arrGroups(x) = "*" Then
Regards,
Rob.
If UCase(arrGroups(x)) = UCase(oAD.sAMAccountName) or arrGroups(x) = "*" Then
to this
If UCase(arrGroups(x)) = UCase(oAD.DisplayName) or UCase(arrGroups(x)) = UCase(oAD.sAMAccountName) or arrGroups(x) = "*" Then
Regards,
Rob.
ASKER
Rob,
Here is the new code.... however the members are still showing as disabled when I checked them manually in Active Directory and they are in fact enabled.
Also, the domain admins and enterprise admins are still not being listed in the output for some reason....
Here is the new code.... however the members are still showing as disabled when I checked them manually in Active Directory and they are in fact enabled.
Also, the domain admins and enterprise admins are still not being listed in the output for some reason....
strScanGroups = "Admins,Management,Staff,Domain Admins,Enterprise Admins"
strSMTPRelay = "xxxx"
strFrom = "GroupMembershipChecks@blablabla.com"
strTo = "blablabla.com"
Dim rootDSE, domainObject, adDomain, mailDomain
Set rootDSE = GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set domainObject = GetObject("LDAP://" & domainContainer)
Set fs = CreateObject ("Scripting.FileSystemObject")
Set outFile = fs.CreateTextFile (".\AdminGroupReport.txt")
arrGroups = Split(strScanGroups, ",")
strPad = " "
scanDomain(domainObject)
outFile.Close
strTextBody = "Attached is the report listing members in key admin groups." & vbCRLF & vbCRLF & vbCRLF
strTextBody = strTextBody & "These groups include: " & vbCRLF & vbCRLF
For x = 0 to UBound(arrGroups)
strTextBody = strTextBody & arrGroups(x) & vbCRLF
Next
Set objMessage = CreateObject("CDO.Message")
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Subject = "Admin User Report for " & Now()
objMessage.From = strFrom
objMessage.To = strTo
objMessage.TextBody = strTextBody
objMessage.AddAttachment Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "AdminGroupReport.txt"
objMessage.Send
Wscript.Echo "Done!"
Sub scanDomain(oObject)
Dim oAD
For Each oAD in oObject
Select Case oAD.Class
Case "group"
For x = 0 to UBound(arrGroups)
If UCase(arrGroups(x)) = UCase(oAD.DisplayName) or UCase(arrGroups(x)) = UCase(oAD.sAMAccountName) or arrGroups(x) = "*" Then
outFile.WriteLine
outFile.WriteLine "----------------------------------------------------------------------------------------------------------"
outFile.WriteLine "Group: " & Replace(oAD.Name, "CN=" ,"")
oAD.GetInfo
On Error Resume Next
arrMemberOf = oAD.GetEx("member")
If Err.Number = 0 then
Err.Clear
For Each strMember in arrMemberOf
Set oUser = GetObject("LDAP://" & strMember)
If Err.Number <> 0 Then
outFile.WriteLine " " & strMember & Left(strPad, 80 - Len(strMember)) & "User Status Unknown"
Err.Clear
Else
If oUser.AccountDisabled = TRUE then
strStatus = "Account Disabled"
Else
strStatus = ""
End If
outFile.WriteLine " " & oUser.sAMAccountName & Left(strPad, 40 - Len(oUser.sAMAccountName)) & oUser.displayName & Left(strPad, 40 - Len(oUser.displayName)) & strStatus
End If
Next
Else
Err.Clear
End If
On Error Goto 0
End If
Next
Case "organizationalUnit"
scanDomain(oAD)
Case "container"
scanDomain(oAD)
End Select
Next
End Sub
Hi, I've rewritten the code completely....this works for me now.
Regards,
Rob.
Regards,
Rob.
arrScanGroups = Array( _
"Admins", _
"Management", _
"Staff", _
"Domain Admins", _
"Enterprise Admins" _
)
strSMTPRelay = "xxxx"
strFrom = "GroupMembershipChecks@blablabla.com"
strTo = "blablabla.com"
strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "AdminGroupReport.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile(strOutputFile, True)
Const ADS_UF_ACCOUNTDISABLE = 2
For Each strGroupName In arrScanGroups
strGroupADsPath = Get_LDAP_User_Properties("group", "name", strGroupName, "adsPath")
If InStr(strGroupADsPath, "LDAP://") > 0 Then
Set objGroup = GetObject(strGroupADsPath)
For Each objMember In objGroup.Members
If LCase(objMember.Class) = "user" Then
Set objUser = GetObject(objMember.adsPath)
intUAC = objUser.Get("userAccountControl")
If intUAC And ADS_UF_ACCOUNTDISABLE Then
strStatus = "Account Disabled"
Else
strStatus = ""
End If
objOutputFile.WriteLine """" & strGroupName & """,""" & Mid(objUser.Name, 4) & """,""" & strStatus & """"
Set objUser = Nothing
End If
Next
Set objGroup = Nothing
Else
MsgBox "There was an error returning the adsPath of " & strGroupName
End If
Next
objOutputFile.Close
strTextBody = "Attached is the report listing members in key admin groups." & vbCRLF & vbCRLF & vbCRLF
strTextBody = strTextBody & "These groups include: " & vbCRLF & vbCRLF
For Each strGroupName In arrScanGroups
strTextBody = strTextBody & strGroupName & vbCRLF
Next
Set objMessage = CreateObject("CDO.Message")
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Subject = "Admin User Report for " & Now()
objMessage.From = strFrom
objMessage.To = strTo
objMessage.TextBody = strTextBody
objMessage.AddAttachment strOutputFile
objMessage.Send
WScript.Echo "Done"
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
' This is a custom function that connects to the Active Directory, and returns the specific
' Active Directory attribute value, of a specific Object.
' strObjectType: usually "User" or "Computer"
' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
' It filters the results by the value of strObjectToGet
' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
' For example, if you are searching based on the user account name, strSearchField
' would be "samAccountName", and strObjectToGet would be that speicific account name,
' such as "jsmith". This equates to "WHERE 'samAccountName' = 'jsmith'"
' strCommaDelimProps: the field from the object to actually return. For example, if you wanted
' the home folder path, as defined by the AD, for a specific user, this would be
' "homeDirectory". If you want to return the ADsPath so that you can bind to that
' user and get your own parameters from them, then use "ADsPath" as a return string,
' then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
' Now we're checking if the user account passed may have a domain already specified,
' in which case we connect to that domain in AD, instead of the default one.
If InStr(strObjectToGet, "\") > 0 Then
arrGroupBits = Split(strObjectToGet, "\")
strDC = arrGroupBits(0)
strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
strObjectToGet = arrGroupBits(1)
Else
' Otherwise we just connect to the default domain
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
End If
strBase = "<LDAP://" & strDNSDomain & ">"
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set ADOConnection = CreateObject("ADODB.Connection")
ADOConnection.Provider = "ADsDSOObject"
ADOConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = ADOConnection
' Filter on user objects.
'strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = strCommaDelimProps
arrProperties = Split(strCommaDelimProps, ",")
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
' Define the maximum records to return
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strReturnVal = ""
Do Until adoRecordset.EOF
' Retrieve values and display.
For intCount = LBound(arrProperties) To UBound(arrProperties)
If strReturnVal = "" Then
strReturnVal = adoRecordset.Fields(intCount).Value
Else
strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value
End If
Next
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
ADOConnection.Close
Get_LDAP_User_Properties = strReturnVal
End Function
ASKER
Rob,
I'm getting an error
Line: 25
Char: 5
Error: The directory property cannot be found in the cache
Code: 8000500D
I'm researching right now and it looks as if there is an illegal LDAP reference in the script. If I found out what it is, I'll update the code and paste the script back in just in case someone needs it in the future.
I'm getting an error
Line: 25
Char: 5
Error: The directory property cannot be found in the cache
Code: 8000500D
I'm researching right now and it looks as if there is an illegal LDAP reference in the script. If I found out what it is, I'll update the code and paste the script back in just in case someone needs it in the future.
ASKER
Still haven't figured out the problem.... any suggestions would be appreciated.
ASKER CERTIFIED SOLUTION
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
VB Script
VBScript (Visual Basic Scripting Edition) is an interpreted scripting language developed by Microsoft that is modeled on Visual Basic, but with some important differences. VBScript is commonly used for automating administrative and other tasks in Windows operating systems (by means of the Windows Script Host) and for server-side scripting in ASP web applications. It is also used for client-side scripting in Internet Explorer, specifically in intranet web applications.
39K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
TRUSTED BY
ASKER
Open in new window