Solved

Export usernames & domain groups from Active Directory to excel

Posted on 2008-10-28
1
845 Views
Last Modified: 2013-12-24
I borrowed the code below from a previous question/solution post that works great. I would, however, like to also list the username as well. Right now, it lists the user's name and the domaing group. Example:
User's Name             Domain Group
Hutson, Phoebe        All Users
Hutson, Phoebe       Test Group
Joy, Rob                   All Users
Joy, Rob                   Test Group

I'd like it give me the following:
User's Name             Username (network ID)      Domain Group
Hutson, Phoebe         PHutson                                All Users
Hutson, Phoebe        PHutson                                Test Group
Joy, Rob                   Rojo                                      All Users
Joy, Rob                   Rojo                                       Test Group

Thanks in advance for your help!

See code below:

On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2

Dim objGroup, objExcel, iRow, strUser
'Set objGroup = GetObject("LDAP://cn=nameofgroup,ou=Other Groups and Accounts - Public,dc=MyDomain,dc=com")
strGroup="src*"

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 64000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCommand.CommandText = _
    "SELECT Name, adSPath FROM 'LDAP://DC=BHCS,DC=pvt' WHERE objectCategory='group' " & _
        "AND Name='" & strGroup & "'"

Set objRecordSet = objCommand.Execute

Set objExcel = CreateObject("Excel.Application")
With objExcel
  .SheetsInNewWorkbook = 1
  .Workbooks.Add
  .Visible = True
 .Worksheets.Item(1).Name = objRecordSet.Fields("Name").Value
  irow=1

objRecordSet.MoveFirst
Do Until objRecordSet.EOF
  Set objGroup = GetObject(objRecordSet.Fields("adsPath").Value)
  For Each strUser in objGroup.Member
     Set objUser =  GetObject("LDAP://" & strUser)
    .Cells(iRow,1) = objUser.CN
    .Cells(iRow, 2) = objRecordSet.Fields("Name").Value
    irow=irow + 1
  Next
  set objGroup=Nothing
  objRecordSet.MoveNext
Loop

 .Columns(1).entirecolumn.autofit
End With

Set objExcel = Nothing
Set objGroup = Nothing
0
Comment
Question by:snazzy129
1 Comment
 
LVL 23

Accepted Solution

by:
irudyk earned 500 total points
Comment Utility
Try something like the following code
On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2
 

Dim objGroup, objExcel, iRow, strUser

'Set objGroup = GetObject("LDAP://cn=nameofgroup,ou=Other Groups and Accounts - Public,dc=MyDomain,dc=com")

strGroup="src*"
 

Set objConnection = CreateObject("ADODB.Connection")

Set objCommand =   CreateObject("ADODB.Command")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
 

objCommand.Properties("Page Size") = 64000

objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 

objCommand.CommandText = _

    "SELECT Name, adSPath FROM 'LDAP://DC=BHCS,DC=pvt' WHERE objectCategory='group' " & _

        "AND Name='" & strGroup & "'"
 

Set objRecordSet = objCommand.Execute
 

Set objExcel = CreateObject("Excel.Application")

With objExcel

  .SheetsInNewWorkbook = 1

  .Workbooks.Add

  .Visible = True

 .Worksheets.Item(1).Name = objRecordSet.Fields("Name").Value

  irow=1
 

objRecordSet.MoveFirst

Do Until objRecordSet.EOF

  Set objGroup = GetObject(objRecordSet.Fields("adsPath").Value)

  For Each strUser in objGroup.Member

     Set objUser =  GetObject("LDAP://" & strUser)

    .Cells(iRow,1) = objUser.CN

    .Cells(iRow,2) = objUser.sAMAccountName

    .Cells(iRow, 3) = objRecordSet.Fields("Name").Value

    irow=irow + 1

  Next

  set objGroup=Nothing

  objRecordSet.MoveNext

Loop
 

 .Columns(1).entirecolumn.autofit

End With
 

Set objExcel = Nothing

Set objGroup = Nothing

Open in new window

0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Resolve DNS query failed errors for Exchange
Restoring deleted objects in Active Directory has been a standard feature in Active Directory for many years, yet some admins may not know what is available.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now