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

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

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

Logged in as: Guest

arrSession:exec spGetSession 2,16,34962

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

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Export AD Information to MS Access, (computers, users, and Group Memberships)
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Export AD Information to MS Access, (computers, users, ... - 5/30/2006 4:53:31 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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.

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

< Message edited by edavis6678 -- 5/30/2006 5:13:40 AM >

Revisions: 2 | Post #: 1

RE: export ad user's group memberships to MS Access - 5/30/2006 5:09:40 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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

< Message edited by edavis6678 -- 5/31/2006 2:22:15 AM >

(in reply to edavis6678)

Revisions: 1 | Post #: 2

RE: export ad user's group memberships to MS Access - 5/30/2006 5:13:05 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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"

< Message edited by edavis6678 -- 5/31/2006 2:22:03 AM >

(in reply to edavis6678)

Revisions: 1 | Post #: 3

RE: export ad user's group memberships to MS Access - 5/30/2006 6:36:27 PM

gdewrance

Posts: 587
Score: 3
Joined: 3/16/2006
Status: offline

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")

(in reply to edavis6678)

Revisions: 2 | Post #: 4

RE: export ad user's group memberships to MS Access - 5/31/2006 2:22:59 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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

I edited the originals and removed the hyperlinks.

(in reply to gdewrance)

Post #: 5

RE: export ad user's group memberships to MS Access - 5/31/2006 5:07:36 PM

gdewrance

Posts: 587
Score: 3
Joined: 3/16/2006
Status: offline

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.

< Message edited by gdewrance -- 5/31/2006 5:11:02 PM >

_____________________________

"You start coding. I'll go find out what they want."

(in reply to edavis6678)

Revisions: 1 | Post #: 6

RE: Export AD Information to MS Access, (computers, use... - 6/2/2006 4:29:12 AM

docjay

Posts: 3
Score: 0
Joined: 6/2/2006
Status: offline

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

(in reply to edavis6678)

Post #: 7

RE: Export AD Information to MS Access, (computers, use... - 6/5/2006 3:48:07 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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

(in reply to docjay)

Revisions: 1 | Post #: 8

RE: Export AD Information to MS Access, (computers, use... - 6/5/2006 4:09:59 AM

docjay

Posts: 3
Score: 0
Joined: 6/2/2006
Status: offline

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

(in reply to edavis6678)

Post #: 9

RE: Export AD Information to MS Access, (computers, use... - 6/5/2006 5:43:07 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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)

< Message edited by edavis6678 -- 6/5/2006 5:45:43 AM >

(in reply to docjay)

Revisions: 1 | Post #: 10

RE: Export AD Information to MS Access, (computers, use... - 6/5/2006 7:15:54 AM

docjay

Posts: 3
Score: 0
Joined: 6/2/2006
Status: offline

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

(in reply to edavis6678)

Post #: 11

RE: Export AD Information to MS Access, (computers, use... - 6/6/2006 3:39:13 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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.

(in reply to docjay)

Post #: 12

RE: Export AD Information to MS Access, (computers, use... - 6/27/2006 4:40:19 AM

DataBase

Posts: 3
Score: 0
Joined: 6/27/2006
Status: offline

Worked fine for me :-)

when we will see any import script ?

Thanks allot

(in reply to edavis6678)

Post #: 13

RE: Export AD Information to MS Access, (computers, use... - 2/13/2008 11:00:06 PM

jamiepryer

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

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....

(in reply to DataBase)

Post #: 14

RE: Export AD Information to MS Access, (computers, use... - 2/14/2008 11:15:30 PM

jamiepryer

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

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

(in reply to jamiepryer)

Post #: 15

RE: Export AD Information to MS Access, (computers, use... - 2/19/2008 4:22:48 AM

edavis6678

Posts: 122
Score: 0
Joined: 1/12/2006
Status: offline

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

(in reply to jamiepryer)

Post #: 16

RE: Export AD Information to MS Access, (computers, use... - 2/20/2008 10:33:26 PM

jamiepryer

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

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?

(in reply to edavis6678)

Post #: 17

If you found our site useful please link to us <a href="http://www.visualbasicscript.com">VisualBasicScript.com</a>.

All Forums >> [Scripting] >> Post a VBScript >> Export AD Information to MS Access, (computers, users, and Group Memberships)

Page: [1]

Jump to:

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

Post New Thread

Reply to Message

Post New Poll

Submit Vote

Delete My Own Post

Delete