AD UserInfo + Group Membership

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

AD UserInfo + Group Membership - HELP

Logged in as: Guest

arrSession:exec spGetSession 2,7,56682

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [General Forum] >> Other Programming/Scripting Languages >> AD UserInfo + Group Membership - HELP
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

AD UserInfo + Group Membership - HELP - 2/14/2008 4:04:30 AM

interacss

Posts: 2
Score: 0
Joined: 2/13/2008
Status: offline

Dim conn, dbpath, sqlcommand, dbTableName
       Dim UserName, Department, CN
       Dim ObjMember, ObjGroup, strGroupName, strActiveGroup, ObjGroupMember
       Dim strDN, objMemberList
       Dim objConnection, objCommand, objRootDSE, strDNSDomain
       ' Dictionary object to track group membership.
       objMemberList = CreateObject("Scripting.Dictionary")
       objMemberList.CompareMode = vbTextCompare
       '######################################
       dbpath = "c:\ADUserInfo.mdb" ' change this to the path of your database
       'strDomainName = "DOMAINNAME" ' change this to your domain name
       objDomain = GetObject("LDAP://rootDse")
       DomainString = objDomain.Get("dnsHostName")
       '######################################
       dbTableName = "tblGroups"
       conn = CreateObject("ADODB.Connection")
       conn.Provider = "Microsoft.Jet.OLEDB.4.0"
       conn.Open(dbpath)
       On Error Resume Next
       sqlcommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(255), FirstName Text(255), LastName Text(255), SamAccountName Text(255), Department Text(255), IsPrimary BIT, UserAdsPath Memo,ADGroupDescription Text(255))"
       conn.Execute(sqlcommand)
       On Error GoTo 0
       sqlcommand = "DELETE * FROM [" & dbTableName & "]"
       conn.Execute(sqlcommand)
       objRoot = GetObject("LDAP://RootDSE")
       strDNC = objRoot.Get("DefaultNamingContext")
       strDNSDomain = objRoot.Get("defaultNamingContext")
       objOU = GetObject("LDAP://" & strDNC)
       ' Setup ADO.
       objConnection = CreateObject("ADODB.Connection")
       objCommand = CreateObject("ADODB.Command")
       objConnection.Provider = "ADsDSOObject"
       objConnection.Open("Active Directory Provider")
       objCommand.ActiveConnection = objConnection
       objCommand.Properties("Page Size") = 100
       objCommand.Properties("Timeout") = 30
       objCommand.Properties("Cache Results") = False
       Call enumMembers(objOU)
       conn.close()
       conn = Nothing
       MsgBox("Done")
   End Sub

Sub enumMembers(ActiveObjectOU)
       For Each objGroupMember In ActiveObjectOU
           If objGroupMember.Class = "group" Then
               Call EnumGroup(ObjGroupMember)
           End If
           If objGroupMember.Class = "organizationalUnit" Or objGroupMember.Class = "container" Then
               enumMembers(ObjGroupMember)
           End If
       Next
   End Sub

Sub EnumGroup(ByVal objADGroup)
       Dim strFilter, strAttributes, objRecordSet, intGroupToken
       Dim objMember, strQuery, strNTName
       Dim objCommand, conn
       ' Retrieve "primaryGroupToken" of group.
       objADGroup.GetInfoEx(Array(primaryGroupToken), 0)
       intGroupToken = objADGroup.Get("primaryGroupToken")
       ' Use ADO to search for users whose "primaryGroupID" matches the
       ' group "primaryGroupToken".
       strFilter = "(primaryGroupID=" & intGroupToken & ")"
       strAttributes = "sAMAccountName"
       strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter & ";" & strAttributes & ";subtree"
       'WScript.echo strQuery
       objCommand.CommandText = strQuery
       objRecordSet = objCommand.Execute
       Do Until objRecordSet.EOF
           strNTName = objRecordSet.Fields("sAMAccountName")
           'ADGroupName = FixValue(ObjADGroup.AdsPath)' use this for ADGroupName if you just want the ADS Path
           ADGroupName = Mid(FixValue(objADGroup.Name), 4)
           SamAccountName = FixValue(strNTName)
           IsPrimary = "1"
           UserAdsPath = "(Not Available because used WinNT Provider)"
           qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, FirstName, LastName, SamAccountName, Department, IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & FirstName & "','" & LastName & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
           conn.Execute(qryInsert)
           objRecordSet.MoveNext()
       Loop
       For Each objMember In objADGroup.Members
           On Error Resume Next
           ADGroupName = Mid(FixValue(objADGroup.Name), 4)
           ADGroupDescription = FixValue(objADGroup.Description)
           SamAccountName = FixValue(objMember.SamAccountName)
           FirstName = FixValue(objMember.GivenName)
           LastName = FixValue(objMember.sn)
           Department = FixValue(objMember.Department)
           UserADSPath = FixValue(objMember.AdsPath)
           IsPrimary = "0"
           On Error GoTo 0
           qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, FirstName, LastName, ADGroupDescription, SamAccountName, Department, IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & FirstName & "','" & LastName & "','" & ADGroupDescription & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserADSPath & "')"
           'WScript.Echo qryInsert
           conn.Execute(qryInsert)
           On Error Resume Next
       Next
       objMember = Nothing
       objRecordSet = Nothing
   End Sub
   Function FixValue(ByVal sValue)
       FixValue = Replace(sValue, "'", "''")
   End Function

on line 64 I think, objADGroup.GetInfoEx(Array(primaryGroupToken), 0) is currently throwing an error saying: 'Array' is a type and cannot be used as an expression.

This code that I'm using is a slightly modified version of: http://www.visualbasicscript.com/m_34962/tm.htm

The script itself it working as a standalone *.vbs file, but I cannot seem to get it to compile in MS VB 2008 Express Edition due to this Array error.

Any offers of help muchly appreciated!