Forum Search:
Forum.Brain-Cluster.com: Brain Cluster Technical Forum
Ultimate forum for Technical Discussions

Home » Microsoft » Windows Server » Active Directory » VBscript to put AD users into an MS access table
VBscript to put AD users into an MS access table [message #159550] Fri, 31 July 2009 09:33 Go to next message
Joe Brand  is currently offline Joe Brand  United States
Messages: 1
Registered: July 2009
Junior Member
Hi

I'm trying to create a module in access that will match 5000 users in a
table to their AD account properties and return their SamAccountName,
Common name, e-mail address, Last login, Disabled account, and OU
attributes and present them in a new table.

I have a script that I have been using. It creates the table fine, but
doesn't seem to poll AD correctly and doesn't return any data.

I'm not an expert on VB and any help would be appreciated as I have
been searching all over the place but have been unable to find a
resolution.

Thank you
Joe

Code:

Code:
--------------------
Option Compare Database

Sub test()

Dim dbTableName
Dim dbPath
Dim LastLogin

Set objRoot = GetObject("LDAP://RootDSE")
strDNC = objRoot.Get("DefaultNamingContext")
Set objGroup = GetObject("LDAP://ou=test, dc=eu, dc=acme, dc=net")
dbPath = "C:\DocuShareaccountsmdb.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), LastLogin Text(255), Disabled Text(255), OU text(255))"
conn.Execute (SqlCommand)
On Error GoTo 0

SqlCommand = "DELETE * FROM [" & dbTableName & "]"
conn.Execute (SqlCommand)
Call enumMembers(objGroup)
MsgBox "Done"

End Sub


Sub enumMembers(objGroup)
For Each objMember In objGroup
If objMember.Class = "user" Then
Set Container = GetObject(objMember.Parent)
SamAccountName = FixValue(objMember.SamAccountName, "SamAccountName")
CN = FixValue(objMember.CN, "CN")
Disabled = objMember.AccountDisabled
OU = FixValue(objMember.OU, "OU")
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
conn.Execute (QryInsert)
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
--------------------


--
Joe Brand
------------------------------------------------------------ ------------
Joe Brand's Profile: http://forums.techarena.in/members/120121.htm
View this thread: http://forums.techarena.in/active-directory/1224245.htm

http://forums.techarena.in
Re: VBscript to put AD users into an MS access table [message #159554 is a reply to message #159550] Fri, 31 July 2009 11:28 Go to previous message
rlmueller-nospam  is currently offline rlmueller-nospam  United States
Messages: 292
Registered: July 2009
Senior Member
"Joe Brand" <Joe.Brand.3w753b@DoNotSpam.com> wrote in message
news:Joe.Brand.3w753b@DoNotSpam.com...
>
> Hi
>
> I'm trying to create a module in access that will match 5000 users in a
> table to their AD account properties and return their SamAccountName,
> Common name, e-mail address, Last login, Disabled account, and OU
> attributes and present them in a new table.
>
> I have a script that I have been using. It creates the table fine, but
> doesn't seem to poll AD correctly and doesn't return any data.
>
> I'm not an expert on VB and any help would be appreciated as I have
> been searching all over the place but have been unable to find a
> resolution.
>
> Thank you
> Joe
>
> Code:
>
> Code:
> --------------------
> Option Compare Database
>
> Sub test()
>
> Dim dbTableName
> Dim dbPath
> Dim LastLogin
>
> Set objRoot = GetObject("LDAP://RootDSE")
> strDNC = objRoot.Get("DefaultNamingContext")
> Set objGroup = GetObject("LDAP://ou=test, dc=eu, dc=acme, dc=net")
> dbPath = "C:\DocuShareaccountsmdb.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), LastLogin Text(255), Disabled Text(255), OU
> text(255))"
> conn.Execute (SqlCommand)
> On Error GoTo 0
>
> SqlCommand = "DELETE * FROM [" & dbTableName & "]"
> conn.Execute (SqlCommand)
> Call enumMembers(objGroup)
> MsgBox "Done"
>
> End Sub
>
>
> Sub enumMembers(objGroup)
> For Each objMember In objGroup
> If objMember.Class = "user" Then
> Set Container = GetObject(objMember.Parent)
> SamAccountName = FixValue(objMember.SamAccountName, "SamAccountName")
> CN = FixValue(objMember.CN, "CN")
> Disabled = objMember.AccountDisabled
> OU = FixValue(objMember.OU, "OU")
> 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
> conn.Execute (QryInsert)
> 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
> --------------------
>
>
> --
> Joe Brand
> ------------------------------------------------------------ ------------
> Joe Brand's Profile: http://forums.techarena.in/members/120121.htm
> View this thread: http://forums.techarena.in/active-directory/1224245.htm
>
> http://forums.techarena.in
>

I'll need to check, but I think your Sub EnumMembers is OK (although
objGroup refers to an OU, not a group). However, the variable QryInsert is
not assigned a value, so nothing is executed. You probably want to construct
an INSERT statement. Perhaps:

QryInsert = "INSERT INTO [" & dbTableName & "] " _
& "(SamAccountName, CN, LastLogin, Disabled, OU) " _
& "VALUES('" & SamAccountName & "', '" & CN _
& "', '" & LastLogin & "', '" & Disabled & "', '" & OU & "'")

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--
Previous Topic:Is there an AD2003 tool collecting expired pwds from stale accounts and notify those users?
Next Topic:Staging/Development
Goto Forum:
  


Current Time: Tue Jan 23 16:20:39 MST 2018

Total time taken to generate the page: 0.08719 seconds
.:: Contact :: Home ::Sitemap::.

Powered by: FUDforum 3.0.0RC2.
Copyright ©2001-2009 FUDforum Bulletin Board Software