asked on

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

ITNC

ASKER

Here is the code instead of having to download....

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


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
									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

Open in new window

RobSampson

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.

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

Open in new window

RobSampson

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.

ITNC

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....

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

Open in new window

RobSampson

Hi, I've rewritten the code completely....this works for me now.

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

Open in new window

ITNC

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.

ITNC

ASKER

Still haven't figured out the problem.... any suggestions would be appreciated.

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial