I LOVE this tool. Thanks Julien! I needed to get a list of users and group membership, however I wanted a list that would repeat the user record for each group the user was a member of. That way I could give a department a list of everyone that was a member of their particular group. All I had to do was change Julien’s code just a little to get it to work. Here’s what I did:
Private Sub cbExtract_Click()
Application.ScreenUpdating = False
Dim ModeRecalcul As Long
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Purge existing data
Sheets("Users").Range("A3:L65000").ClearContents
'Session Manager declaration
Dim SessionManager, Sess As SessionMgr
'Enterprise Session declaration
Dim esession As EnterpriseSession
'InfoStore declaration
Dim iStore As InfoStore
'Info Objects declaration
Dim Users, Groups As InfoObjects
'Info Object declaration
Dim UserItem, GroupItem As InfoObject
'User Object declaration
Dim UserObject As User
Dim Rng As Excel.Range
Dim RowNum, GroupNum As Long
On Error GoTo ErrorHandler
Dim ErrorState As String
'Session Manager instanciation
Set SessionManager = CreateObject("CrystalEnterprise.SessionMgr")
'Enterprise Session instanciation
Set esession = SessionManager.Logon(tbName, tbPassword, tbCMS, "secEnterprise")
'Infostore instanciation
Set iStore = esession.Service("", "InfoStore")
'document the users
Set Users = iStore.Query("SELECT TOP 1000000 SI_EMAIL_ADDRESS, SI_FORCE_PASSWORD_CHANGE, SI_NAME, SI_ID, SI_USERGROUPS, SI_USERFULLNAME, SI_ALIASES, SI_DESCRIPTION, SI_LASTLOGONTIME, SI_PASSWORDEXPIRE FROM CI_SYSTEMOBJECTS Where SI_KIND='User'")
RowNum = 2
Set Rng = Sheets("Users").Cells
'Write in the top the server/login used, the update date
Rng(1, 4) = "Server: " & tbCMS & Chr(10) & "User: " & tbName & Chr(10) & "Update Date: " & Date & " " & Time
For Each UserItem In Users
Set UserObject = UserItem
For Each GroupId In UserObject.Groups
Set Groups = iStore.Query("SELECT SI_NAME, SI_DESCRIPTION FROM CI_SYSTEMOBJECTS Where SI_ID=" & GroupId)
RowNum = RowNum + 1
Rng(RowNum, 1) = UserItem.ID
Rng(RowNum, 2) = UserItem.Title
ErrorState = "FullName"
Rng(RowNum, 3) = UserObject.FullName
Rng(RowNum, 4) = UserObject.EmailAddress
GroupNum = 0
' For Each GroupId In UserObject.Groups
' GroupNum = GroupNum + 1
' Set Groups = iStore.Query("SELECT SI_NAME FROM CI_SYSTEMOBJECTS Where SI_ID=" & GroupId)
' If (GroupNum = 1) Then
' Rng(RowNum, 5) = Groups(1).Title
' Else:
' Rng(RowNum, 5) = Rng(RowNum, 5) & Chr(10) & Groups(1).Title
' End If
' Next GroupId
Rng(RowNum, 5) = Groups(1).Title
Rng(RowNum, 6) = Groups(1).Description
If (UserObject.Aliases(1).Disabled) Then
Rng(RowNum, 7) = 1
Else
Rng(RowNum, 7) = 0
End If
If (UserObject.ChangePasswordAtNextLogon) Then
Rng(RowNum, 8) = 1
Else
Rng(RowNum, 8) = 0
End If
Rng(RowNum, 9) = UserObject.Description
ErrorState = "LastLogon"
Rng(RowNum, 10) = UserObject.Properties("SI_LASTLOGONTIME")
Next GroupId
Next UserItem
Application.Calculation = ModeRecalcul
Calculate
Application.EnableEvents = True
Me.Hide
CleanUp:
Me.Hide
On Error Resume Next
esession.Logoff
Application.Calculation = ModeRecalcul
Calculate
Application.EnableEvents = True
Exit Sub
ErrorHandler:
If Err.Number = -2147210697 Then
If ErrorState = "FullName" Then Rng(RowNum, 3) = "Error on Full Name"
If ErrorState = "LastLogon" Then Rng(RowNum, 10) = ""
Resume Next
End If
Me.Hide
MsgBox Err.Source & " - " & Err.Number & ": " & Err.Description & " " & Err.HelpContext, _
vbCritical, "Failure in UsersGroups()"
Resume CleanUp
End Sub
All I had to do was move the loop for the groups to be inclusive of all the user fields and it works perfectly.
alpha1145 
(BOB member since 2006-01-04)
(BOB member since 2004-01-09)
(BOB member since 2007-01-18)