Solved: GAL export | Experts Exchange

Gal Export :

csvde -r "(objectClass=user)" -d "dc=domain,dc=com" -l
displayName,proxyAddresses -f c:\Gal.csv

or check this:
How to export GAL (Global Address List)
http://support.microsoft.com/kb/555397

mass2612

Hi,

You can export the GAL using csvde or ldifde and probably via a vbscript.

http://support.microsoft.com/kb/555397

http://msexchangetips.blogspot.com/2006/08/exchange-export-gal-using-csvde.html

Chris Dent

We do the same thing. I don't handle the web server side, but for AD I have a rather small script which pulls out the fields we need. CSVDE would work as well, it's just easier for me to filter out unwanted bits in script.

You can find a cut-down version of the VbScript I use below.

Chris

' IntranetExport.vbs
'
' Author: Chris Dent
' Date: 21/11/2006
' Modified: 13/12/2006

Option Explicit

Const ADS_SCOPE_SUBTREE = 2

Dim objConnection, objCommand, objRecordSet, objRootDSE, objFileSystem, objFile, objShell
Dim strADSPath, strGivenName, strSN, strDescription, strCompany, strDepartment, strOffice
Dim strTelephone, strMail
Dim booCheckRecord

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT aDSPath, givenName, sN, title, description, company, department, " &_
      "physicalDeliveryOfficeName, telephoneNumber, mail, l FROM 'GC://" &_
      objRootDSE.Get("rootDomainNamingContext") & "'"
Set objRootDSE = Nothing

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile("intranet_import.csv", 2, True, 0)

While Not objRecordSet.EOF
      strADSPath = objRecordSet.Fields("aDSPath")

      booCheckRecord = False
      If InStr(1, strADSPath, "<User Root OU>", VbTextCompare) > 0 Then
            booCheckRecord = True
      End If

      If booCheckRecord = True Then
            If IsNull(objRecordSet.Fields("givenName")) Or _
                        IsNull(objRecordSet.Fields("sN")) Then
                  booCheckRecord = False
            End If
            If IsNull(objRecordSet.Fields("mail")) Then
                  booCheckRecord = False
            End If
      End If

      If booCheckRecord = True Then
            On Error Resume Next
            strGivenName = "" : strGivenName = objRecordSet.Fields("givenName")
            strSN = "" : strSN = objRecordSet.Fields("sN")
            strDescription = "" : strDescription = objRecordSet.Fields("title")
            strCompany = "" : strCompany = objRecordSet.Fields("company")
            strDepartment = "" : strDepartment = objRecordSet.Fields("department")
            strOffice = "" : strOffice = objRecordSet.Fields("physicalDeliveryOfficeName")
            strTelephone = "" : strTelephone = objRecordSet.Fields("telephoneNumber")
            strMail = "" : strMail = objRecordSet.Fields("mail")

            objFile.WriteLine """" & strGivenName & """,""" & strSN & """,""" & strDescription &_
                  """,""" & strCompany & """,""" & strDepartment & """,""" & strOffice &_
                  """,""" & strTelephone & """,""" & strMail & """"

            On Error Goto 0
      End If
      objRecordSet.MoveNext
Wend

objConnection.Close

Set objFile = Nothing
Set objFileSystem = Nothing

Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing

credmood

ASKER

Thanks for all your pointers, Chris I like the VB script..Ill do some testing and come back for the points awarding ceremony ;o)

Cheers

credmood

ASKER

Chris, not being a VB expert...what am I missing?

I have run the script, the csv is created but no information populates the csv...clearly Im doing something wrong or not reading you correctly

Could you guide me in the right direction

Cheers

Chris Dent

Most likely thing would be these lines:

If InStr(1, strADSPath, "<User Root OU>", VbTextCompare) > 0 Then
booCheckRecord = True
End If

We can remove them which will simplify things, it's there to hide all the accounts we're not so interested in. The downside is that you must change "<User Root OU>" to whatever yours is.

For us that's something like:

Domain
| -- Disabled Accounts
| -- Offices
| | --- London
| | --- Oxford
| --- Remote Users
etc.

So it makes the lines:

If InStr(1, strADSPath, "Offices", VbTextCompare) > 0 Then
booCheckRecord = True
End If

To ensure the export only contains user accounts under the Offices OU.

Or we can just remove it altogether, that makes the script as below, this time checking only that there's a First Name, Last Name and E-Mail Address:

' IntranetExport.vbs
'
' Author: Chris Dent
' Date: 21/11/2006
' Modified: 13/12/2006

Option Explicit

Const ADS_SCOPE_SUBTREE = 2

Dim objConnection, objCommand, objRecordSet, objRootDSE, objFileSystem, objFile, objShell
Dim strADSPath, strGivenName, strSN, strDescription, strCompany, strDepartment, strOffice
Dim strTelephone, strMail
Dim booCheckRecord

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT aDSPath, givenName, sN, title, description, company, department, " &_
"physicalDeliveryOfficeName, telephoneNumber, mail, l FROM 'GC://" &_
objRootDSE.Get("rootDomainNamingContext") & "'"
Set objRootDSE = Nothing

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile("intranet_import.csv", 2, True, 0)

While Not objRecordSet.EOF
strADSPath = objRecordSet.Fields("aDSPath")

If booCheckRecord = True Then
If IsNull(objRecordSet.Fields("givenName")) Or _
IsNull(objRecordSet.Fields("sN")) Then
booCheckRecord = False
End If
If IsNull(objRecordSet.Fields("mail")) Then
booCheckRecord = False
End If
End If

If booCheckRecord = True Then
On Error Resume Next
strGivenName = "" : strGivenName = objRecordSet.Fields("givenName")
strSN = "" : strSN = objRecordSet.Fields("sN")
strDescription = "" : strDescription = objRecordSet.Fields("title")
strCompany = "" : strCompany = objRecordSet.Fields("company")
strDepartment = "" : strDepartment = objRecordSet.Fields("department")
strOffice = "" : strOffice = objRecordSet.Fields("physicalDeliveryOfficeName")
strTelephone = "" : strTelephone = objRecordSet.Fields("telephoneNumber")
strMail = "" : strMail = objRecordSet.Fields("mail")

objFile.WriteLine """" & strGivenName & """,""" & strSN & """,""" & strDescription &_
""",""" & strCompany & """,""" & strDepartment & """,""" & strOffice &_
""",""" & strTelephone & """,""" & strMail & """"

On Error Goto 0
End If
objRecordSet.MoveNext
Wend

objConnection.Close

Set objFile = Nothing
Set objFileSystem = Nothing

Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing

Chris Dent

Oops... sorry, that won't work quite like that. Here's a better correction:

' IntranetExport.vbs
'
' Author: Chris Dent
' Date: 21/11/2006
' Modified: 13/12/2006

Option Explicit

Const ADS_SCOPE_SUBTREE = 2

Dim objConnection, objCommand, objRecordSet, objRootDSE, objFileSystem, objFile, objShell
Dim strADSPath, strGivenName, strSN, strDescription, strCompany, strDepartment, strOffice
Dim strTelephone, strMail
Dim booCheckRecord

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT aDSPath, givenName, sN, title, description, company, department, " &_
"physicalDeliveryOfficeName, telephoneNumber, mail, l FROM 'GC://" &_
objRootDSE.Get("rootDomainNamingContext") & "'"
Set objRootDSE = Nothing

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile("intranet_import.csv", 2, True, 0)

While Not objRecordSet.EOF
strADSPath = objRecordSet.Fields("aDSPath")

booCheckRecord = True
If IsNull(objRecordSet.Fields("givenName")) Or _
IsNull(objRecordSet.Fields("sN")) Then
booCheckRecord = False
End If
If IsNull(objRecordSet.Fields("mail")) Then
booCheckRecord = False
End If

If booCheckRecord = True Then
On Error Resume Next
strGivenName = "" : strGivenName = objRecordSet.Fields("givenName")
strSN = "" : strSN = objRecordSet.Fields("sN")
strDescription = "" : strDescription = objRecordSet.Fields("title")
strCompany = "" : strCompany = objRecordSet.Fields("company")
strDepartment = "" : strDepartment = objRecordSet.Fields("department")
strOffice = "" : strOffice = objRecordSet.Fields("physicalDeliveryOfficeName")
strTelephone = "" : strTelephone = objRecordSet.Fields("telephoneNumber")
strMail = "" : strMail = objRecordSet.Fields("mail")

objFile.WriteLine """" & strGivenName & """,""" & strSN & """,""" & strDescription &_
""",""" & strCompany & """,""" & strDepartment & """,""" & strOffice &_
""",""" & strTelephone & """,""" & strMail & """"

On Error Goto 0
End If
objRecordSet.MoveNext
Wend

objConnection.Close

Set objFile = Nothing
Set objFileSystem = Nothing

Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing

credmood

ASKER

Hi Chris, thats great...works very well.

Can i ask quickly...do you have a reverse script, so I can fill in the blanks and import back into AD?

Chris Dent

The reverse is more difficult, how did you want to go about editing it? It would work nicely if we output the distinguishedName in the same set of data.

Then comparing and pushing it back is fairly easy to do.

Chris

credmood

ASKER

I have no issue outputting the distinguishedName as well, where do I add this field to the script? I have a member of my staff that will trawl through the csv to modify/add missing info, so Im not worried about the time it takes..just want to get it right before letting the bosses know.

Thanks for your help, if I could award a 1000 points I would

Cheers

credmood

ASKER

Chris, sorry for bothering you...
Just wondering if you you were still working on this code, its been a few days since your last post. I apreciate that you may have other issues, be away etc so I aplogise if this is the case

Chris Dent

Sorry, sidetracked again :)

First, if we pop the DistinguishedName into here:

' IntranetExport.vbs
'
' Author: Chris Dent
' Date: 21/11/2006
' Modified: 13/12/2006

Option Explicit

Const ADS_SCOPE_SUBTREE = 2

Dim objConnection, objCommand, objRecordSet, objRootDSE, objFileSystem, objFile, objShell
Dim strADSPath, strGivenName, strSN, strDescription, strCompany, strDepartment, strOffice
Dim strTelephone, strMail, strDN
Dim booCheckRecord

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT aDSPath, givenName, sN, title, description, company, department, " &_
"physicalDeliveryOfficeName, telephoneNumber, mail, l FROM 'GC://" &_
objRootDSE.Get("rootDomainNamingContext") & "'"
Set objRootDSE = Nothing

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile("intranet_import.csv", 2, True, 0)

While Not objRecordSet.EOF
strADSPath = objRecordSet.Fields("aDSPath")

booCheckRecord = True
If IsNull(objRecordSet.Fields("givenName")) Or _
IsNull(objRecordSet.Fields("sN")) Then
booCheckRecord = False
End If
If IsNull(objRecordSet.Fields("mail")) Then
booCheckRecord = False
End If

If booCheckRecord = True Then
On Error Resume Next
strGivenName = "" : strGivenName = objRecordSet.Fields("givenName")
strSN = "" : strSN = objRecordSet.Fields("sN")
strDescription = "" : strDescription = objRecordSet.Fields("title")
strCompany = "" : strCompany = objRecordSet.Fields("company")
strDepartment = "" : strDepartment = objRecordSet.Fields("department")
strOffice = "" : strOffice = objRecordSet.Fields("physicalDeliveryOfficeName")
strTelephone = "" : strTelephone = objRecordSet.Fields("telephoneNumber")
strMail = "" : strMail = objRecordSet.Fields("mail")
strDN = "" : strDN = objRecordSet.Fields("distinguishedName")

objFile.WriteLine """" & strGivenName & """,""" & strSN & """,""" & strDescription &_
""",""" & strCompany & """,""" & strDepartment & """,""" & strOffice &_
""",""" & strTelephone & """,""" & strMail & """,""" & strDN & """"

On Error Goto 0
End If
objRecordSet.MoveNext
Wend

objConnection.Close

Set objFile = Nothing
Set objFileSystem = Nothing

Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing

Chris Dent

I made an error above, it needs this bit:

Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT aDSPath, givenName, sN, title, description, company, department, " &_
"physicalDeliveryOfficeName, telephoneNumber, mail, l, distinguishedName FROM 'GC://" &_
objRootDSE.Get("rootDomainNamingContext") & "'"
Set objRootDSE = Nothing

Overwriting the section that's almost identical to it.

Chris

Chris Dent

Now for the import. This one is fairly complex, it's an adaptation of a script I wrote before, if it all works properly it's quite flexible about the input (as long as it's a text file).

To work with the output from the script above you will need this set of command line parameters:

UserDataImport -f intranet_import.csv -a "givenName,sN,title,company,department,physicalDeliveryOfficeName,telephoneNumber,mail,distinguishedName" -q -t

Bit of a long command, but it does all need to go on one line.

And here is the script itself:

Option Explicit

' UserDataImport.vbs
'
' Generic User Data Import Script

'
' Subroutines
'

Sub WriteLog(strMessage, booLogOnly)
      Dim strScriptHost
      Dim booShowCommandLine

      strScriptHost = WScript.FullName
      strScriptHost = Right(strScriptHost, Len(strScriptHost) - InStrRev(strScriptHost, "\"))

      booShowCommandLine = True
      If (UCase(strScriptHost) = "WSCRIPT.EXE") Then
            booShowCommandLine = False
      End If
      If booLogOnly = True Then
            booShowCommandLine = False
      End If

      objLogFile.WriteLine "[" & Now() & "] " & strMessage
      If booShowCommandLine = True Then
            wscript.echo "[" & Now() & "] " & strMessage
      End If
End Sub

Sub UsageText
      Dim strMessage

      strMessage = "Usage:" & VbCrLf & VbCrLf
      strMessage = strMessage & "cscript " & WScript.ScriptName & " -f <File Name> " & VbCrLf & VbTab
      strMessage = strMessage & "[-r] [-s] [-a <Attributes>] [-d <Delimiter>] [-q] [-t]" & VbCrLf
      strMessage = strMessage & VbCrLf
      strMessage = strMessage & "Options:" & VbCrLf
      strMessage = strMessage & VbTab & "-f <File Name> - Input File Name (Required)" & VbCrLf
      strMessage = strMessage & VbTab & "-r - Read the Header Line as AD Fields" & VbCrLf
      strMessage = strMessage & VbTab & "-s - Skip the Header Line" & VbCrLf
      strMessage = strMessage & VbTab & "-a <Attributes> - AD Attibutes to write Fields to (Required " & VbCrLf
      strMessage = strMessage & VbTab & "if not using Header)" & VbCrLf
      strMessage = strMessage & VbTab & "-d <Delimiter> - File Delimiter. Uses comma if not specified" & VbCrlf
      strMessage = strMessage & VbTab & "-q - Data Values in Quotes" & VbCrLf
      strMessage = strMessage & VbTab & "-t - Test Only" & VbCrLf
      WScript.Echo strMessage
      WScript.Quit
End Sub

Sub SortArgv
      Dim objArgv
      Dim strArgv
      Dim i, intFileName, intFields, intFileDelimiter
      Dim booFileName, booFields, booFileDelimiter

      Set objArgv = WScript.Arguments

      If objArgv.Count < 1 Then
            UsageText()
      End If

      booFileName = False : booReadHeader = False : booSkipHeader= False
      booFields = False : booFileDelimiter = False : booQuotes = False : booTestOnly = False

      i = 0

      For Each strArgv in objArgv
            i = i + 1
            strArgv = LCase(strArgv)
            If strArgv = "-f" Then ' Required
                  booFileName = True
                  intFileName = i
            ElseIf strArgv = "-r" Then ' Cannot be set as well as -s
                  booReadHeader = True
            ElseIf strArgv = "-s" Then ' Cannot be set as well as -r. Must have -a
                  booSkipHeader = True
            ElseIf strArgv = "-a" Then ' Required if booReadHeader = False
                  booFields = True
                  intFields = i
            ElseIf strArgv = "-d" Then ' Optional - Default ","
                  booFileDelimiter = True
                  intFileDelimiter = i
            ElseIf strArgv = "-q" Then
                  booQuotes = True
            ElseIf strArgv = "-t" Then ' Optional - Test Mode
                  booTestOnly = True
            End If
      Next

      ' Check the requirements for the Arguments

      If booFileName = False Then
            UsageText
      End If

      If booReadHeader = True And booSkipHeader = True Then
            UsageText
      End If

      If (booSkipHeader = True Or booReadHeader = False) And booFields = False Then
            UsageText
      End If

      ' Read the Arguments into the Variables

      If booFileName = True Then
            If objArgv.Count < (intFileName + 1) Then
                  UsageText
            Else
                  strFileName = objArgv(intFileName)
            End If
      End If

      If booFields = True Then
            If objArgv.Count < (intFields + 1) Then
                  UsageText
            Else
                  strFields = objArgv(intFields)
            End If
      End If

      If booFileDelimiter = True Then
            If objArgv.Count < (intFileDelimiter + 1) Then
                  UsageText
            Else
                  strFileDelimiter = objArgv(intFileDelimiter)
            End If
      Else
            strFileDelimiter = ","
      End If

      If booQuotes = True Then
            strFileDelimiter = """" & strFileDelimiter & """"
      End If

      Set objArgv = Nothing
End Sub

Sub ReadSource(strFileName)
      Dim objFile, objStream, objFileMap
      Dim strTemp, strLine, strField, strDN, strLeft, strMid, strRight
      Dim arrFields, arrFieldData, arrUserData(), arrLine
      Dim i, j, k

      Set objFile = objFileSystem.GetFile(strFileName)
      Set objStream = objFile.OpenAsTextStream(1, 0)

      WriteLog "Reading Data File (" & objFile.Name & ")", False

      ' These options are, in part, mutually exclusive. Command Line checks will resolve any conflicts.

      If booReadHeader = True Then
            strLine = objStream.ReadLine
            If booQuotes = False Then
                  arrFields = Split(strLine, strFileDelimiter)
            ElseIf booQuotes = True Then
                  strLine = Left(strLine, Len(strLine) - 1)
                  strLine = Right(strLine, Len(strLine) - 1)

                  arrFields = Split(strLine, strFileDelimiter)
            End If
      Else
            arrFields = Split(strFields, ",")
      End If

      If booSkipHeader = True Then
            objStream.SkipLine
      End If

      ' Quick Check to make sure distinguishedName is in there somewhere.

      strTemp = Join(arrFields, "")
      If InStr(1, strTemp, "distinguishedName", VbTextCompare) = 0 Then
            WriteLog "Error in Data: No Distinguished Name Defined", True
            UsageText()
      End If

      ' This is the Map for the files contents. Like fields must be contiguous and will be concatenated.

      Set objFileMap = CreateObject("Scripting.Dictionary")
      For i = 0 To UBound(arrFields)
            strField = arrFields(i)
            If Not objFileMap.Exists(strField) Then
                  objFileMap.Add strField, Array(1, i)
            ElseIf objFileMap.Exists(strField) Then
                  arrFieldData = objFileMap(strField)
                  arrFieldData(0) = arrFieldData(0) + 1
                  objFileMap(strField) = arrFieldData
            End If
      Next

      ' Read the File based on the Map and load into objData.

      Do While Not objStream.AtEndOfStream
            strLine = objStream.ReadLine

            ' If quoted remove the preceeding and trailing quotes prior to splitting

            If booQuotes = True Then
                  strLine = Left(strLine, Len(strLine) - 1)
                  strLine = Right(strLine, Len(strLine) - 1)
            End If

            ' Nasty bit of code to get rid unexpected fields with quotes and comma's in - breaks CSV

            If booQuotes = False Then
                  Do Until InStr(strLine, """") = 0
                        If InStr(strLine, """") Then
                              strLeft = Left(strLine, InStr(strLine, """") - 1)
                              strLine = Right(strLine, Len(strLine) - InStr(strLine, """"))
                              strMid = Replace(Left(strLine, InStr(strLine, """") - 1), ",", "")
                              strRight = Right(strLine, Len(strLine) - InStr(strLine, """"))
                              strLine = strLeft & strMid & strRight
                        End If
                  Loop
            End If

            arrLine = Split(strLine, strFileDelimiter)
            strDN = LCase(arrLine(objFileMap("distinguishedName")(1)))

            ' Code to cope with multiple fields of the same name. Concatenates with a comma and a space.
            ' Prefixes every other field with the attribute it's to be loaded into.

            ReDim arrUserData(UBound(arrLine) - 1)
            j = 0
            For Each strField in objFileMap
                  If LCase(strField) <> "distinguishedname" Then
                        If objFileMap(strField)(0) > 1 And arrUserData(j) = "" Then
                              strTemp = ""
                              For k = 1 to objFileMap(strField)(0)
                                    If arrLine(j + k) <> "" Then
                                          strTemp = strTemp & Trim(arrLine(j + k)) & ", "
                                    End If
                              Next
                              If Len(strTemp) > 2 Then
                                    strTemp = Left(strTemp, Len(strTemp) - 2)
                              End If
                              arrUserData(j) = strField & "=" & strTemp
                        ElseIf arrUserData(j) = "" Then
                              arrUserData(j) = strField & "=" & Trim(arrLine(objFileMap(strField)(1)))
                        End If
                        j = j + 1
                  End If
            Next

            If objData.Exists(strDN) Then
                  WriteLog "Duplicate Found in Source Data: " & strDN, True
            Else
                  objData.Add strDN, arrUserData
            End If

            ' Cleanup the Array for the next data entry
            Erase arrUserData
      Loop

      WriteLog "Completed Reading Data File (" & objFile.Name & ")", False

      Set objStream = Nothing
      Set objFile = Nothing
End Sub

Sub ImportData
      Dim objUser
      Dim strDN

      WriteLog "Starting Import", False

      For Each strDN in objData
            On Error Resume Next : Err.Clear
            Set objUser = GetObject("LDAP://" & strDN)
            Set objUser = Nothing
            If Err.Number <> 0 Then
                  WriteLog "Failed to Connect to Account: " & strDN, True
                  On Error Goto 0
            Else
                  On Error Goto 0

                  UpdateUser strDN
            End If

      Next

      WriteLog "Completed Import", False
End Sub

Sub UpdateUser(strDN)
      Dim objUser
      Dim strData, strAttribute, strValue
      Dim arrTemp

      Set objUser = GetObject("LDAP://" & strDN)

      For Each strData in objData(strDN)
            arrTemp = Split(strData, "=")
            strAttribute = arrTemp(0)
            strValue = arrTemp(1)

            CheckUpdate objUser, strAttribute, strValue
      Next

      Set objUser = Nothing
End Sub

Sub CheckUpdate(objUser, strAttribute, strValue)
      Dim strCurrentValue

      On Error Resume Next
      strCurrentValue = "" : strCurrentValue = objUser.Get(strAttribute)
      If LCase(strCurrentValue) <> LCase(strValue) Then
            WriteLog "Updating " & strAttribute & " Attribute: " &_
                  objUser.Get("displayName") & ": Old: " & strCurrentValue &_
                  " New: " & strValue, True
            If booTestOnly = False Then
                  Err.Clear
                  objUser.Put strAttribute, strValue
                  objUser.SetInfo
                  If Err.Number <> 0 Then
                        WriteLog objUser.Name & ": Error Updating " & strAttribute & " with " & strValue, True
                        WriteLog objUser.Name & ": " & Err.Description
                  End If
            End If
      End If
      On Error Goto 0
End Sub

'
' Main Code
'

' Global Variables

Dim objFileSystem, objData, objLogFile
Dim strTimeStamp, strLogFile, strFileName, strFileDelimiter, strFields
Dim booReadHeader, booSkipHeader, booQuotes, booTestOnly
Dim arrTemp

' Object Initialisation

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objData = CreateObject("Scripting.Dictionary")

' Log File Init

strTimeStamp = CStr(Now())
strTimeStamp = Replace(strTimeStamp, "/", "")
strTimeStamp = Replace(strTimeStamp, " ", "")
strTimeStamp = Replace(strTimeStamp, ":", "")
If Not objFileSystem.FolderExists("Logs") Then
      objFileSystem.CreateFolder("Logs")
End If
arrTemp = Split(WScript.ScriptName, ".")
strLogFile = "Logs\" & arrTemp(0) & strTimeStamp & ".log"
Set objLogFile = objFileSystem.OpenTextFile(strLogFile, 2, True, 0)

SortArgv

WriteLog "Script Started", False
If booTestOnly = True Then
      WriteLog "** Running in Test Mode **", False
End If

ReadSource(strFileName)
ImportData

WriteLog "Script Completed", False

Set objLogFile = Nothing
Set objData = Nothing
Set objFileSystem = Nothing

Chris Dent

One note..

The -t up there puts the script into test mode. It'll write a log file of all the changes it would have made, but not actually commit them. The -t needs taking off if you're happy with what it would like to do.

Chris

credmood

ASKER

Chris, sorry if Im being dim but how do I run the command line parameters and the VB script?
I created a batch file with the command line thinking that as long as Im in the dir with all the required files it would call these files? However when looking at the vb script it doesnt mention the CSV which is obviously has to in order to get the changed info.

I am clearly missing somehting here, and apologise for this in advance

Thanks for your help

credmood

ASKER

Hi Chris, just me being dim
All I had to do was reference userdatimport.vbs in the command line rather than just userdataimport without the .vbs extension. It didnt like not knowing it was a vbs..which I thought would'nt matter as there is only one userdatimport reference in the directory I am running it from. It is clearly fussy :o)

And voila it works like a charm..thank you very much for your help

Chris Dent

You're most welcome :-D

Chris