C
Charles Simpson
I have the following script that creates a table in Access of AD users. I'd
like to change the script so that instead of deleting and recreating the
table, it simply updates the table with changes, additions and deletions.
--------
Dim dbTableName
Dim dbPath
Dim LastLogin
Set objRoot = GetObject("LDAP://RootDSE")
strDNC = objRoot.Get("DefaultNamingContext")
Set objGroup = GetObject("LDAP://" & strDNC)
dbPath = "E:\Program Files\ACTEmployeeProfiler\ACTEmployeeImport.accdb"
dbTableName = "AD Users"
Set conn = CreateObject("ADODB.Connection")
conn.Provider="Microsoft.ACE.OLEDB.12.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 CN = "mcship01" 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
like to change the script so that instead of deleting and recreating the
table, it simply updates the table with changes, additions and deletions.
--------
Dim dbTableName
Dim dbPath
Dim LastLogin
Set objRoot = GetObject("LDAP://RootDSE")
strDNC = objRoot.Get("DefaultNamingContext")
Set objGroup = GetObject("LDAP://" & strDNC)
dbPath = "E:\Program Files\ACTEmployeeProfiler\ACTEmployeeImport.accdb"
dbTableName = "AD Users"
Set conn = CreateObject("ADODB.Connection")
conn.Provider="Microsoft.ACE.OLEDB.12.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 CN = "mcship01" 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