C
Charles Simpson
Hi
I have the following script that I use to import Active Directory user data
into Access 2003. However it will not work with Access 2007. When I try to
indicate that the database is an .accdb file, I get the following error:
Error: Unrecognized database format "c:\ACTEmployeeImport.accdb.accdb"
Code: 80004005
Source: Microsoft JET Database Engine
Here is the script:
Dim dbTableName
Dim dbPath
Dim LastLogin
Set objRoot = GetObject("LDAP://RootDSE")
strDNC = objRoot.Get("DefaultNamingContext")
Set objGroup = GetObject("LDAP://" & strDNC)
dbPath = "C:\ACTEmployeeImport.accdb"
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
If not(Disabled = "True" or CN = "TLCADMIN" or OU = "Training" or OU =
"Visiting Teachers" or OU = "Disabled" or OU = "Restricted Access" or OU =
"Service Accounts" or OU = "TEST" or OU = "Users" or OU = "corporate" or OU =
"GPO Tests" or OU = "Mandatory Wallpaper" or Descrip = "Generic_Login") Then
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)
End If
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
I have the following script that I use to import Active Directory user data
into Access 2003. However it will not work with Access 2007. When I try to
indicate that the database is an .accdb file, I get the following error:
Error: Unrecognized database format "c:\ACTEmployeeImport.accdb.accdb"
Code: 80004005
Source: Microsoft JET Database Engine
Here is the script:
Dim dbTableName
Dim dbPath
Dim LastLogin
Set objRoot = GetObject("LDAP://RootDSE")
strDNC = objRoot.Get("DefaultNamingContext")
Set objGroup = GetObject("LDAP://" & strDNC)
dbPath = "C:\ACTEmployeeImport.accdb"
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
If not(Disabled = "True" or CN = "TLCADMIN" or OU = "Training" or OU =
"Visiting Teachers" or OU = "Disabled" or OU = "Restricted Access" or OU =
"Service Accounts" or OU = "TEST" or OU = "Users" or OU = "corporate" or OU =
"GPO Tests" or OU = "Mandatory Wallpaper" or Descrip = "Generic_Login") Then
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)
End If
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