AD Group List Macro to pull users of each group

[poptot]

Hello,

I been poking around for several days and thought it was time to ask my question. I'm trying to create an Excel Macro\VB script in Excel 2007 using VB 6.5. I want the script pull all the AD users from the AD groups listed in current wooksheet A2 thru A400(ish). So far I have it working with 1 group in A2, however, I'm running into 2 issues.

1. Currently my OU is hardcoded to a test group, so It doesn't work for all groups in the domain. I'm not sure how to pull the OU's into the LDAP lookup.

Set ADList = ActiveSheet.Range("A2")
Set objDistList = GetObject("LDAP://CN=" & ADList & ",OU=Security Groups,OU=!Common,DC="mydomain",DC="mycompany",DC=com")

2. I'm not sure how to setup the script to loop for Each AD group (including not running for blank cells).

Any help that could be provided would be greatly appreciated.

Thank You!
poptot

Sub ADGroupLookup()
' Extract a list of users from a specific group in AD into Excel.
Dim objDistList, objExcel, ExcelRow, strUser, strDistListName, strOU, ADList
' This line specifies the group name, OU, and AD domain name, edit to suit your system.
Set ADList = ActiveSheet.Range("A2")
Set objDistList = GetObject("[URL]ldap://CN[/URL]=" & ADList & ",OU=Security Groups,OU=!Common,DC=mydomain,DC=mycompany,DC=com")
Set objExcel = CreateObject("Excel.Application")
With objExcel
    .SheetsInNewWorkbook = 1
    .Workbooks.Add
    .Visible = True
    .Worksheets.Item(1).Name = Mid(objDistList.Name, _
    InStr(1, objDistList.Name, "=") + 1)
 ExcelRow = 1
 
 ' This section sets the Excel header row names, these can be changed to anything more human readable if using this script to simply extract a list.
 ' If the header names are left as is, the resulting Excel file can be edited, saved as CSV, and used by an AD import tool to do bulk updates.
 ' Note if using this to do a bulk update, format every cell as text. Also Excel does weird things with phone numbers if you re-open the saved CSV file with Excel.
 ' [URL="http://www.wisesoft.co.uk/software/bulkadusers/default.aspx"]Bulk AD Users[/URL] Free bulk AD update tool (download link top right).
 ' Outlook uses these fields in the address book and contact properties. If all this stuff is filled in it makes the Outlook address book a very handy tool.
 ' Android and iOS Exchange email clients will also read this information into their addressbooks.
 ' [URL="http://www.wisesoft.co.uk/scripts/activedirectoryschema.aspx"]WiseSoft - Active Directory Schema Guide. VBScript samples to modify user attributes.[/URL] Clickable interface to see what all the LDAP attribute names relate to in the user properties fields.
 ' Edit / remove / change the order as you please, make sure it matches up with the next section.
 .Cells(ExcelRow, 1) = "User Name" ' User login name - Account tab. This field is often used by AD import tools to identify the account to update.
 .Cells(ExcelRow, 2) = "Last Name" ' Last name - General tab.
 .Cells(ExcelRow, 3) = "First Name" ' First name - General tab.
 .Cells(ExcelRow, 4) = "E-mail Address" ' E-mail - General tab.
 .Cells(ExcelRow, 5) = "AD Group Name"
 
 .Rows(1).Font.Bold = True
 
 ExcelRow = ExcelRow + 1
 For Each strUser In objDistList.Member
 Set objUser = GetObject("LDAP://" & strUser)
 ' LDAP attribute names read from Active Directory.
 .Cells(ExcelRow, 1) = objUser.sAMAccountName
 .Cells(ExcelRow, 2) = objUser.sn
 .Cells(ExcelRow, 3) = objUser.givenName
 .Cells(ExcelRow, 4) = objUser.mail
 .Cells(ExcelRow, 5) = ADList
 '.Cells(ExcelRow, 5) = Mid(objDistList.Name, _
    InStr(1, objDistList.Name, "=") + 1)
 
  ExcelRow = ExcelRow + 1
 Next
 ' Auto fit the columns.
 .Columns(1).EntireColumn.AutoFit
 .Columns(2).EntireColumn.AutoFit
 .Columns(3).EntireColumn.AutoFit
 .Columns(4).EntireColumn.AutoFit
 .Columns(5).EntireColumn.AutoFit
 End With
Set objExcel = Nothing
Set objDistList = Nothing
End Sub

[TABLE="width: 48"]
<TBODY>[TR]
[TD="width: 64, bgcolor: transparent"][/TD]
[/TR]
</TBODY>[/TABLE]

 

[poptot]

bump