Enumeration Groups a user is a memberof.

[yellowartist]

I am trying to pull out a some attributes from a user's Active Directory account that is a member of a specific group and place it into a spreadsheet.

I cannot get it to list the SMTP addresses and the groups. I also cannot get it to loop through all users.

Here is the script.


Option Explicit
on error resume next
Dim objGroup, objuser, objExcel, iRow, strUser, iCol
dim strExcelPath, objApp

strExcelPath = "\\Server\folder\Scripts\EMP_SEP\Work_Log.xls"

set objExcel = CreateObject("Excel.Application")

' Create a new workbook.
objExcel.Workbooks.Add
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Work_Log"
' Populate spreadsheet cells with user attributes.

Set objGroup = GetObject("LDAP://CN=GG_ES_ACCT_ADMIN,OU=Groups,OU=KBS,DC=kochind,DC=com")


Set objExcel = CreateObject("Excel.Application")
With objExcel
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Visible = false
iRow=1

For Each strUser in objGroup.Member
Set objUser = GetObject("LDAP://" & strUser)
.Cells(irow,1) = ("User Name: " & objUser.CN)
.Cells(irow,2) = ("Role ID: " & objUser.sAMAccountName)
.Cells(irow,3) = ("Object(s): " & objUser.distinguishedName)
.Cells(irow,4) = ("Home Drive: " & objUser.homeDirectory)
.Cells(irow,6) = ("Mailbox Store: " & objUser.homeMDB)
.Cells(irow,7) = ("ALIAS: " & objuser.mailNickname)
.Cells(irow,8) = ("Email Address(es): " & objuser.Getex("proxyAddresses"))
.Cells(irow,9) = ("Groups: " & Objgroup.Getex("memberof"))
.Cells(irow,10) = " "
.cells(irow,11) = "Disabled the AD account (Do not perform this step for KST)"
.Cells(irow,12) = "Changed Password"
.cells(irow,13) = "Set Delivery Restrictions – Accept Messages: Only from: MAILTEAM (do not perform this step if email is being forwarded)"
.cells(irow,14) = "Hid from Exchange address list (Do not perform this step for FHR)"
.cells(irow,15) = "Added EXEMPT in Extension Attribute 5"
.cells(irow,16) = "Added to GG_KBS_ES"
.cells(irow,17) = "Inserted current date in MM/DD/YY format to AD account Full name and Display name: "
irow + 1
Next
End With

' Save the spreadsheet, close the workbook and exit.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
'WScript.Echo "Spreadsheet Created"



'Set objApp = CreateObject("WScript.Shell")

'objApp.Run "cmd /C net use n: \\Server\folder\Scripts\EMP_SEP [Password] & n: & EnumerateMembers"

 

[yellowartist]

Thanks for the simplified answer. I am curious then how this piece is working....

' Add to Group
If strougroup = False Then
Set objgroup = GetObject("LDAP://" & Strougroup)
objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array(strdn)
objGroup.SetInfo
End If

Thanks again!

 

[mrmovie]

the scripting engine will try and implicitly convert strougroup to a boolean and make a comparison. all depends on the rules for converting a string to a boolean...not really recommended i guess but the engine will try...

an example would be if

intA = 1
If intA = True Then

Else

End If

 

[djtech2k]

It probably is not working. Its probably just passing thru the IF.

To diagnose, I would do this:

' Add to Group
If strougroup = False Then
msgbox "Add Group strgroup=False"
Set objgroup = GetObject("LDAP://" & Strougroup)
objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array(strdn)
objGroup.SetInfo
End If

'Remove from Groups
If StrouProxy = True Then
msgbox "Remove Group strproxy=True"
Set objgroup = GetObject("LDAP://" & StrouProxy)
objGroup.PutEx ADS_PROPERTY_DELETE, "member", Array(strdn)
objGroup.SetInfo
End If

This way you will get a popup box when it passes thru the IF.

 

[markdmac]

Here is code which I believe will do what you are asking

Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4 

Set WSHNetwork = CreateObject("WScript.Network")

'Grab the user name
UserString = WSHNetwork.UserName
'Call function to get the users distinguished name
UserDN = SearchDistinguishedName(UserString)

'Bind to the user object and check for group memberships later
Set UserObj = GetObject("LDAP://" & UserDN)


bType = False 'Use this to flag for group membership
For Each GroupObj In UserObj.Groups
'Force upper case comparison of the group names, otherwise this is case sensitive.
'See if user is a member of the group
    Select Case UCase(GroupObj.Name)
    	Case GroupNameYouAreSearchingFor
    		WScript.Echo "User is a memer of the desired group."
    		bType = True
    End Select
Next


'User is in the group, delete them from the group
If bType = True Then
	'Now we remove the user from the group
	Set objGroup = GetObject _
   ("LDAP://cn=Atl-Users,cn=Users,dc=NA,dc=fabrikam,dc=com") 
 
	objGroup.PutEx ADS_PROPERTY_DELETE, _
	    "member",Array(UserDN)
	objGroup.SetInfo
End If

'Other option is to ad the user to the group.
If bType = False Then
	Set objGroup = GetObject _
	    ("LDAP://cn=Atl-Users,cn=Users,dc=NA,dc=fabrikam,dc=com")
	objGroup.PutEx ADS_PROPERTY_APPEND, _
	    "member", Array(UserDN)
	objGroup.SetInfo
End If

Public Function SearchDistinguishedName(ByVal vSAN)
    ' Function:     SearchDistinguishedName
    ' Description:  Searches the DistinguishedName for a given SamAccountName
    ' Parameters:   ByVal vSAN - The SamAccountName to search
    ' Returns:      The DistinguishedName Name
    Dim oRootDSE, oConnection, oCommand, oRecordSet

    Set oRootDSE = GetObject("LDAP://rootDSE")
    Set oConnection = CreateObject("ADODB.Connection")
    oConnection.Open "Provider=ADsDSOObject;"
    Set oCommand = CreateObject("ADODB.Command")
    oCommand.ActiveConnection = oConnection
    oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
        ">;(&(objectCategory=User)(samAccountName=" & vSAN & "));distinguishedName;subtree"
    Set oRecordSet = oCommand.Execute
    On Error Resume Next
    SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
    On Error GoTo 0
    oConnection.Close
    Set oRecordSet = Nothing
    Set oCommand = Nothing
    Set oConnection = Nothing
    Set oRootDSE = Nothing
End Function

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.