AD UserInfo + Group Membership - HELP

Author Message
interacss

  • Total Posts : 3
  • Scores: 0
  • Reward points : 0
  • Joined: 2/13/2008
  • Status: offline
AD UserInfo + Group Membership - HELP Thursday, February 14, 2008 5:04 AM (permalink)
0
         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!
 
#1

    Online Bookmarks Sharing: Share/Bookmark

    Jump to:

    Current active users

    There are 0 members and 1 guests.

    Icon Legend and Permission

    • New Messages
    • No New Messages
    • Hot Topic w/ New Messages
    • Hot Topic w/o New Messages
    • Locked w/ New Messages
    • Locked w/o New Messages
    • Read Message
    • Post New Thread
    • Reply to message
    • Post New Poll
    • Submit Vote
    • Post reward post
    • Delete my own posts
    • Delete my own threads
    • Rate post

    2000-2012 ASPPlayground.NET Forum Version 3.9