Export AD Information to MS Access, (computers, users, and Group Memberships)

Reposting the script here.

This script will export all group memberships, (including primary group information), to an MS Access Table.

2 Variables you will need to change.

Line 10 : Location of your MS Access Database
Line 11:  WinNT Domain Name

This script will also create the appropriate table, (you can change the table name on Line 14 if you like)

This also includes the AD Group Description.

 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.
 Set objMemberList = CreateObject("Scripting.Dictionary")
 objMemberList.CompareMode = vbTextCompare
 '######################################
 dbPath = "u:\watcher.mdb" ' change this to the path of your database
 strDomainName = "MYDOMAIN" ' change this to your domain name
 '######################################
 dbTableName = "tblGroups"
 Set conn = CreateObject("ADODB.Connection")
 conn.Provider="Microsoft.Jet.OLEDB.4.0"
 conn.Open dbpath
 On Error Resume Next
 SqlCommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(150), SamAccountName Text(150), Department Text(150), IsPrimary BIT, UserAdsPath Memo,ADGroupDescription Text(150))"
 conn.Execute (SqlCommand)
 On Error Goto 0
 
 SqlCommand = "DELETE * FROM [" & dbTableName & "]"
 conn.Execute (SqlCommand)
 Set objRoot = GetObject("LDAP://RootDSE")
 strDNC = objRoot.Get("DefaultNamingContext")
 strDNSDomain = objRoot.Get("defaultNamingContext")
 Set objOU = GetObject("LDAP://" & strDNC)
 ' Setup ADO.
 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") = 100
 objCommand.Properties("Timeout") = 30
 objCommand.Properties("Cache Results") = False
 Call enummembers(objOU)
 conn.close
 Set Conn = Nothing
 MSgbox "Done"
 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(objADGroup)
 Dim strFilter, strAttributes, objRecordSet, intGroupToken
 Dim objMember, strQuery, strNTName
 ' 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
 Set 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, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
  conn.Execute (qryInsert)
  objRecordSet.MoveNext
 Loop
 For Each objMember In objADGroup.Members
  ADGroupName = Mid(FixValue(objADGroup.Name),4)
  ADGroupDescription = FixValue(ObjADGroup.Description)
  SamAccountName = FixValue(objMember.SamAccountName)
  Department = FixValue(ObjMember.Department)
  UserADSPath = FixValue(objMember.AdsPath)
  IsPrimary = "0"
  qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, ADGroupDescription, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & ADGroupDescription & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
  'WScript.Echo qryInsert
 conn.Execute (qryInsert)
 Next
 Set objMember = Nothing
 Set objRecordSet = Nothing
 End Sub
 Function FixValue(sValue)
 FixValue = Replace(sValue,"'","''")
 End Function
 
 

This script export ALL AD Users in Active Directory and writes the user properties to MS Access Database.

Change Line 10 to the location of your MS Access Database.  (can be blank database, the script auto-creates the table and when re-run, deletes old value and re-populates)

 Dim dbTableName
 Dim dbPath
 Dim LastLogin
 
 Set objRoot = GetObject("LDAP://RootDSE")
 strDNC = objRoot.Get("DefaultNamingContext")
 Set objGroup = GetObject("LDAP://" & strDNC)
 dbPath = "u:\watcher.mdb"
 dbTableName = "AD Users"
 Set conn = CreateObject("ADODB.Connection")
 conn.Provider="Microsoft.Jet.OLEDB.4.0"
 conn.Open dbPath
 On Error Resume Next
 SqlCommand = "CREATE TABLE [" & dbTableName & "] (SamAccountName Text(255), CN Text(255), FirstName Text(255), LastName Text(255)," & _
    "Initials Text(255), Descrip Text(255), Office Text(255), Telephone Text(255), Email Text(255), WebPage Text(255)," & _
    "Addr1 Text(255), City Text(255), State Text(255), ZipCode Text(255), Title Text(255), Department Text(255)," & _
    "Company Text(255), Manager Text(255), Profile Text(255), LoginScript Text(255), HomeDirectory Text(255)," & _
    "HomeDrive Text(255), Adspath Text(255), LastLogin Text(255), OU Text(255), Disabled Text(255))"
 conn.Execute (SqlCommand)
 On Error Goto 0
 
 SqlCommand = "DELETE * FROM [" & dbTableName & "]"
 conn.Execute (SqlCommand)
 Call enummembers(Objgroup)
 MsgBox "Done"
 Sub enumMembers(objGroup)
    For Each objMember In objGroup
  If ObjMember.Class = "user" Then
      set container = getObject(objMember.parent)
   OU = FixValue(Mid(container.name,4), "OU")
   SamAccountName = FixValue(ObjMember.samAccountName, "SamAccountName")
   Cn = FixValue(ObjMember.CN, "CN")
   Disabled = ObjMember.AccountDisabled
   FirstName = FixValue(objMember.GivenName, "FirstName")
   LastName = FixValue(objMember.sn, "LastName")
   initials = FixValue(objMember.initials, "Innitial")
   Descrip = FixValue(objMember.description, "Descript")
   Office = FixValue(objMember.physicalDeliveryOfficeName, "Office")
   Telephone = FixValue(objMember.telephonenumber, "Telephone")
   Email = FixValue(objMember.mail, "Email")
   WebPage = FixValue(objMember.wwwHomePage, "WebPage")
   Addr1 = FixValue(objMember.streetAddress, "Addr1")
   City = FixValue(objMember.l, "City")
   State = FixValue(objMember.st, "State")
   ZipCode = FixValue(objMember.postalCode, "ZipCode")
   Title = FixValue(ObjMember.Title, "Title")
   Department = FixValue(objMember.Department, "Department")
   Company = FixValue(objMember.Company, "Company")
   Manager = FixValue(ObjMember.Manager, "Manager")
   Profile = FixValue(objMember.profilePath, "Profile")
   LoginScript = FixValue(objMember.scriptpath, "LoginScript")
   HomeDirectory = FixValue(ObjMember.HomeDirectory, "HomeDirectory")
   HomeDrive = FixValue(ObjMember.homeDrive, "HomeDrive")
   AdsPath = FixValue(Objmember.Adspath, "AdsPath")
   On Error Resume Next
   LastLogin = FixValue(ObjMember.LastLogin, "LastLogin")
   On Error Goto 0
   If IsDate(LastLogin) = True then
    LastLogin = FixValue(LastLogin, "LastLoginConverted")
    Else
    LastLogin = "1/1/2000"
    
   End If
 qryInsert = "INSERT INTO [" & dbTableName & "](SamAccountName, CN, FirstName, LastName, Initials, Descrip, Office, Telephone, Email, WebPage, Addr1, City, State, ZipCode, Title, Department, Company, Manager, Profile, LoginScript, HomeDirectory, HomeDrive, AdsPath, LastLogin, OU, Disabled) VALUES ('" & SamAccountName & "','" & CN & "','" & FirstName & "','" & LastName & "','" & initials & "','" & Descrip & "','" & Office & "','" & Telephone & "','" & Email & "','" & Webpage & "','" & Addr1 & "','" & City & "','" & State & "','" & ZipCode & "','" & Title & "','" & Department & "','" & Company & "','" & Manager & "','" & Profile & "','" & LoginScript & "','" & HomeDirectory & "','" & HomeDrive & "','" & AdsPath & "','" & LastLogin & "','" & OU & "','" & Disabled & "')"
 conn.Execute (QryInsert)
  SamAccountName = "-"
  Cn = "-"
  FirstName = "-"
  LastName = "-"
  initials = "-"
  Descrip = "-"
  Office = "-"
  Telephone = "-"
  Email = "-"
  WebPage = "-"
  Addr1 = "-"
  City = "-"
  State = "-"
  ZipCode = "-"
  Title = "-"
  Department = "-"
  Company = "-"
  Manager = "-"
  Profile = "-"
  LoginScript = "-"
  HomeDirectory = "-"
  HomeDrive = "-"
  LastLogin = FormatDateTime("1/1/2005")
  OU = "-"
  
        End If
        If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then
            enumMembers (objMember)
        End If
    Next
 End Sub
 Function FixValue(sValue, PropertyName)
 if Err.Number <> 0 Then
  WScript.Echo "Error Code: " & Err.Number & " in reading " & PropertyName & "property"
 End iF
 If VarType(sValue) = 10 or VarType(sValue) = 1 Then
  FixValue = "-Null-"
 End If
  FixValue = Replace(sValue,"'","''")
 End Function
 
 

Exports all Computer Accounts from AD to MS Access.  Includes computers "password age" in days.  (this can give you an indication of when the last time a computer has "checked" in with AD.

Change line 7 to your MS Access Location
Change line 8 to your Domain Name

 Set Fso = CreateObject("Scripting.FileSystemObject")
 Set conn = CreateObject("ADODB.Connection")
 Set objRoot = GetObject("LDAP://RootDSE")
 strDNC = objRoot.Get("DefaultNamingContext")
 '########################
 dbTableName = "Computers"
 dbPath = "u:\watcher.mdb"
 DomainName = "YOURDOMAIN"
 '########################
 conn.Provider="Microsoft.Jet.OLEDB.4.0"
 conn.Open dbPath
 On Error Resume Next
 SqlCommand = "CREATE TABLE [" & dbTableName & "] (ComputerName Text(70), ParentOU Text(50), PasswordAge Long)"
 conn.Execute (SqlCommand)
 On Error Goto 0
 SqlCommand = "DELETE * FROM [" & dbTableName & "]"
 conn.Execute (SqlCommand)
 Set objOU = GetObject ("LDAP://" & strDNC)
 Call enumComps(ObjOU)
        
 Sub EnumComps (ObjOU)
 For Each objChild In objOU
  if ucase(objChild.Class) = "COMPUTER" Then
   set container = getObject(ObjChild.parent)
   OU = FixValue(Mid(container.name,4))
   ComputerName = FixValue(objChild.cn)
   
   set NTaccount = GetObject("WinNT://" & DomainName & "/" & ComputerName & "$")
   PasswordAge = FormatNumber(NTaccount.get("PasswordAge")/86400,0)
   qryInsert = "INSERT INTO [" & dbTableName & "](ComputerName, ParentOU, PasswordAge) VALUES ('" & ComputerName & "','" & OU & "','" & PasswordAge & "')"
   conn.Execute (qryInsert)
  End If
  if ucase(objChild.Class) = "ORGANIZATIONALUNIT" or ucase(objchild.class) = "CONTAINER" Then
   EnumComps (objChild)
  End IF
 Next
 End Sub
 Function FixValue(sValue)
 FixValue = Replace(sValue,"'","''")
 End Function
 MsgBox "Done"
 
 

Just in case people ask why they dont work. here is the problem

Set objRoot = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link
should read
Set objRoot = GetObject("LDAP://RootDSE")

thanks.  Forgot about that http links that get created on RootDSE.

I edited the originals and removed the hyperlinks.

I was playing around so the script could find the default Domain and came up with this.(Worked for me let me know if its correct)

For your Group and Computer Scripts try adding. (AD Users script finds the default already)

Set objDomain = getObject("LDAP://rootDse")
DomainString = objDomain.Get("dnsHostName")

then in the computer script change the line  to Set NTaccount = GetObject("WinNT://" & DomainString & "/" & ComputerName & "$")

and remove or comment out 'DomainName = "DOMAIN"
and
'strDomainName = "DOMAIN" ' change this to your domain name

I just commented it out.

Hey all - I have to agree, wonderful script!   We use it to get all of the users from a global group and run it against a database webveiwer access log for a nice view of who has logged in and used our website within our domain.

Just one thing that I can't get working with it.. with the script that gets everyone that belongs to a group (the one we use - just great!) I need to add first & last name to it so that we can see not only just the username becuase they aren't very descriptive when they make those, so the first & last name helps out a lot.  If anyone could help me out by adding those fields in the script, we would really appreciate it. 

I tried messing around with it, but it just told me that those fields don't exist when I run it.  Here is what I tried to run.

 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.
 Set objMemberList = CreateObject("Scripting.Dictionary")
 objMemberList.CompareMode = vbTextCompare
 '######################################
 dbPath = "c:\watchertest.mdb" ' change this to the path of your database
 strDomainName = "SJMC" ' change this to your domain name
 '######################################
 dbTableName = "tblGroups"
 Set conn = CreateObject("ADODB.Connection")
 conn.Provider="Microsoft.Jet.OLEDB.4.0"
 conn.Open dbpath
 On Error Resume Next
 SqlCommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(150), SamAccountName Text(150), Department Text(150), IsPrimary BIT, UserAdsPath Memo,ADGroupDescription Text(150))"
 conn.Execute (SqlCommand)
 On Error Goto 0
 SqlCommand = "DELETE * FROM [" & dbTableName & "]"
 conn.Execute (SqlCommand)
 Set objRoot = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")
 strDNC = objRoot.Get("DefaultNamingContext")
 strDNSDomain = objRoot.Get("defaultNamingContext")
 Set objOU = GetObject("LDAP://" & strDNC)
 ' Setup ADO.
 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") = 100
 objCommand.Properties("Timeout") = 30
 objCommand.Properties("Cache Results") = False
 Call enummembers(objOU)
 conn.close
 Set Conn = Nothing
 MSgbox "Done"
 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(objADGroup)
 Dim strFilter, strAttributes, objRecordSet, intGroupToken
 Dim objMember, strQuery, strNTName
 ' 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
 Set 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, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
 conn.Execute (qryInsert)
 objRecordSet.MoveNext
 Loop
 For Each objMember In objADGroup.Members
 ADGroupName = Mid(FixValue(objADGroup.Name),4)
 ADGroupDescription = FixValue(ObjADGroup.Description)
 SamAccountName = FixValue(objMember.SamAccountName)
 Disabled = ObjMember.AccountDisabled
 FirstName = FixValue(objMember.GivenName)
 LastName = FixValue(objMember.sn)
 Department = FixValue(ObjMember.Department)
 UserADSPath = FixValue(objMember.AdsPath)
 IsPrimary = "0"
 qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, ADGroupDescription, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & ADGroupDescription & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
 'WScript.Echo qryInsert
 conn.Execute (qryInsert)
 Next
 Set objMember = Nothing
 Set objRecordSet = Nothing
 End Sub
 Function FixValue(sValue)
 FixValue = Replace(sValue,"'","''")
 End Function
 

Really nice to see this in action.  your problem is your table doesn't have the fields available to take data.

Just expand your table and you'll be good to go.

Line 20:

Was this:

SqlCommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(150), SamAccountName Text(150), Department Text(150), IsPrimary BIT, UserAdsPath Memo,ADGroupDescription Text(150))"

Change to this:

SqlCommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(150),FirstName Text(150), LastName Text(150), SamAccountName Text(150), Department Text(150), IsPrimary BIT, UserAdsPath Memo,ADGroupDescription Text(150))"

Hope this explains it.

-Eric

well, I think that just about got it, but there is another error..
 
Line:  81
Char: 1
Error:  The directory property cannot be found in the cache.
code:  8000500D
Source:  Active Directory.
 
here is what I am running now...
 

 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.
 Set objMemberList = CreateObject("Scripting.Dictionary")
 objMemberList.CompareMode = vbTextCompare
 '######################################
 dbPath = "c:\watchertest.mdb" ' change this to the path of your database
 strDomainName = "SJMC" ' change this to your domain name
 '######################################
 dbTableName = "tblGroups"
 Set conn = CreateObject("ADODB.Connection")
 conn.Provider="Microsoft.Jet.OLEDB.4.0"
 conn.Open dbpath
 On Error Resume Next
 SqlCommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(150),FirstName Text(150), LastName Text(150), SamAccountName Text(150), Department Text(150), IsPrimary BIT, UserAdsPath Memo,ADGroupDescription Text(150))" 
 conn.Execute (SqlCommand)
 On Error Goto 0
 SqlCommand = "DELETE * FROM [" & dbTableName & "]"
 conn.Execute (SqlCommand)
 Set objRoot = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")
 strDNC = objRoot.Get("DefaultNamingContext")
 strDNSDomain = objRoot.Get("defaultNamingContext")
 Set objOU = GetObject("LDAP://" & strDNC)
 ' Setup ADO.
 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") = 100
 objCommand.Properties("Timeout") = 30
 objCommand.Properties("Cache Results") = False
 Call enummembers(objOU)
 conn.close
 Set Conn = Nothing
 MSgbox "Done"
 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(objADGroup)
 Dim strFilter, strAttributes, objRecordSet, intGroupToken
 Dim objMember, strQuery, strNTName
 ' 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
 Set 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, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
 conn.Execute (qryInsert)
 objRecordSet.MoveNext
 Loop
 For Each objMember In objADGroup.Members
 ADGroupName = Mid(FixValue(objADGroup.Name),4)
 ADGroupDescription = FixValue(ObjADGroup.Description)
 SamAccountName = FixValue(objMember.SamAccountName)
 Disabled = ObjMember.AccountDisabled
 FirstName = FixValue(objMember.GivenName)
 LastName = FixValue(objMember.sn)
 Department = FixValue(ObjMember.Department)
 UserADSPath = FixValue(objMember.AdsPath)
 IsPrimary = "0"
 qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, ADGroupDescription, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & ADGroupDescription & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
 'WScript.Echo qryInsert
 conn.Execute (qryInsert)
 Next
 Set objMember = Nothing
 Set objRecordSet = Nothing
 End Sub
 Function FixValue(sValue)
 FixValue = Replace(sValue,"'","''")
 End Function
 
 

That happens when a value is NOT set within Active Directory.  (probably a service account or some account with no LastName property value)

The fastest way to solve this problem, (although it could be problematic when debubggin).

Add the famous, ON ERROR RESUME NEXT as you are grabbing the values.  (add it after line 75)

Then, to put error control back on, put ON ERROR GOTO 0 (add this after line 84)
 
(this is the same thing I do on lines 17-20 - I did it there because if you run the script twice the table in the database will already exist,causing the script to bomb.  Kinda lazy to do it that way, but i didn't want to spend half the day writing error trapping when it's just really not necessary)

okay, well the script runs now!  thank you - but the first & last name fields are blank.. is this because of how AD was built on my side?
 
here is what I'm running now...
 

  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.
 Set objMemberList = CreateObject("Scripting.Dictionary")
 objMemberList.CompareMode = vbTextCompare
 '######################################
 dbPath = "c:\watchertest.mdb" ' change this to the path of your database
 strDomainName = "SJMC" ' change this to your domain name
 '######################################
 dbTableName = "tblGroups"
 Set conn = CreateObject("ADODB.Connection")
 conn.Provider="Microsoft.Jet.OLEDB.4.0"
 conn.Open dbpath
 On Error Resume Next
 SqlCommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(150),FirstName Text(150), LastName Text(150), SamAccountName Text(150), Department Text(150), IsPrimary BIT, UserAdsPath Memo,ADGroupDescription Text(150))" 
 conn.Execute (SqlCommand)
 On Error Goto 0
 SqlCommand = "DELETE * FROM [" & dbTableName & "]"
 conn.Execute (SqlCommand)
 Set objRoot = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")
 strDNC = objRoot.Get("DefaultNamingContext")
 strDNSDomain = objRoot.Get("defaultNamingContext")
 Set objOU = GetObject("LDAP://" & strDNC)
 ' Setup ADO.
 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") = 100
 objCommand.Properties("Timeout") = 30
 objCommand.Properties("Cache Results") = False
 Call enummembers(objOU)
 conn.close
 Set Conn = Nothing
 MSgbox "Done"
 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(objADGroup)
 Dim strFilter, strAttributes, objRecordSet, intGroupToken
 Dim objMember, strQuery, strNTName
 ' 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
 Set 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, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
 conn.Execute (qryInsert)
 objRecordSet.MoveNext
 Loop
 For Each objMember In objADGroup.Members
 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"
 qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, ADGroupDescription, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & ADGroupDescription & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
 'WScript.Echo qryInsert
 conn.Execute (qryInsert)
 ON ERROR RESUME NEXT
 Next
 Set objMember = Nothing
 Set objRecordSet = Nothing
 End Sub
 Function FixValue(sValue)
 FixValue = Replace(sValue,"'","''")
 End Function
 
 

The reason is 1 or more of your AD accounts doesnt' have information filled in for the First and Last Name fields.
 
btw...you On error resume next is wrong, below is it modified.
 
(also, if you want to find out what accounts have the missing property, run the script via Cscript and use wscript.echo to see which account has the missing properties.
 

  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, ADGroupDescription, SamAccountName, Department,IsPrimary, UserAdsPath) VALUES ('" & ADGroupName & "','" & ADGroupDescription & "','" & SamAccountName & "','" & Department & "', '" & IsPrimary & "', '" & UserAdsPath & "')"
 'WScript.Echo qryInsert
 conn.Execute (qryInsert)
 
 Next
 
 

Worked fine for me :-)

when we will see any import script ?


Thanks allot

wow - this is a quality scrip, im very impressed - thank you so much!
i never sign up to thse forums however i thought i would take the time to, because of the effort you have put in!
 
i did have one question also...from the first script (This script will export all group memberships, (including primary group information), to an MS Access Table) i would like to remove "department", "UserAdsPath" and also "IS Primary Bit" - however im not too sure how to do this.
Really sorry but can someone advise please....

also, my script keeps crashing, as it time's out or something
anyone know how to stop this or slow it down maybe, so it doesnt keep killing my pc and not completing a full export?
up 45,000 lines in access so far when it dies and there is loads more info to get

Nice to see someone get some use from it.
 
I can answer part of your problem.
 
To modify the data collected, first delete the existing table and re-run the script with the following changes:
 
SqlCommand = "CREATE TABLE [" & dbTableName & "] (ADGroupName Text(150), SamAccountName Text(150),ADGroupDescription Text(150))"
 
Change the Insert command in both places:
 
1st Insert:
 
qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, SamAccountName) VALUES ('" & ADGroupName & "','" & SamAccountName & "')"

2nd Insert:
 
qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, ADGroupDescription, SamAccountName) VALUES ('" & ADGroupName & "','" & ADGroupDescription & "','" & SamAccountName & "')"


As for it dying after 45K records?  You may have to go to MS SQL or some other type of database.  Make sure your MDB is local to your machine.   Not sure what else.
 
Hope this helps

thanks a lot for your help, yet again!
 
its still eating all my cpu and i think it falls over when i dont hvae any physical memory left.
was thinking that i maybe need to add a "wscipt.sleep" into this, but not sure where?

when I run this script, it error

http://img32.imageshack.us/img32/5465/loivbs.jpg

How to Write back to AD from this MS Access Databas!!

Hello,
I have to say. You're the best!!!
Thank you for your script, it allowed me to do what I wanted.
 
I do have a question, is there a good way within your script to resume collection of information if
the script terminates for whatever reason.
In other words. If I have 200,000 records for users accounts but the script stopped at 133,000 in one of the nested OUs in which User OU is stored and I want it to resume this operation, can this be accomplished?
Can you help with the updating of the for loop the most efficient way or some other way?
 
I love your work!!!
Thank you a million.