'=========================================================================
' ConvertOutlookContactsToAD.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 2/9/2013
' REQUIREMENTS: Requires Exchange Tools or CDOEXM.DLL on the computer running
' the script to create Email enabled contacts. The script also uses OLEDB,
' which requires running it with %systemroot%\SysWow64\wscript.exe,
' %systemroot%\SysWow64\cscript.exe, or a 64-bit OLEDB Provider.
' COMMENTS: The script is designed to take an Outlook CSV(DOS) Exported list of
' contacts which is used to create AD contacts. However, not all attributes directly
' translate or have an equivelent. For example, AD only has attributes for a single
' address where Outlook contacts can have business, home, and other addresses. The
' strUserType variable was created to allow you to pick 1 of those 3 options to use
' on the import.
' To use the script export your Outlook contacts to a CSV(DOS) file. Then set the
' variables for the log file (Default is in the same directory as the script), the
' DN of the container you want to create the AD Contacts in, the location of the
' Outlook Exported Contacts CSV file, and the UserType(Business, Home, Other)
' EXAMPLE: Create Contacts with CSV file in the same folder as the script
' Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
' Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
' Dim contactsExport: contactsExport = "export.csv"
' Dim strUserType: strUserType = "Business"
' EXAMPLE: Create Contacts Using the Home Address in the CSV
' Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
' Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
' Dim contactsExport: contactsExport = "export.csv"
' Dim strUserType: strUserType = "Home"
' EXAMPLE: Create Contacts with CSV file in a different folder as the script
' Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
' Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
' Dim contactsExport: contactsExport = "C:\scripts\export.csv"
' Dim strUserType: strUserType = "Business"
'=========================================================================
Option Explicit
' ------ START CONFIGURATION ------
Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
Dim contactsExport: contactsExport = "export.csv"
Dim strUserType: strUserType = "Business" 'Business, Home, Other
' ------ END CONFIGURATION ------
Call Logger(strLogFile, "USER:GENERAL, EMAIL, ORGANIZATION, ADDRESS, TELEPHONE", True)
Call CreateContacts(contactsExport, contactsDN, strUserType, strLogFile)
Wscript.Echo "Finished"
Private Sub CreateContacts(strContactsFile, strContactsDN, UserType, strLogFile)
On Error Resume Next 'Start Error Handling
'Ensure DN not ADS Path
strContactsDN = Replace(strContactsDN,"LDAP://","",1,1,1)
'Grab Contacts With OLEDB - If Using a 64-bit OS you Must Use
' - C:\Windows\SysWow64\wscript.exe OR C:\Windows\SysWow64\cscript.exe
' - Alternatively, use a 64-bit OLEDB Provider (http://www.microsoft.com/en-us/download/details.aspx?id=20065)
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile: Set objFile = objFSO.GetFile(strContactsFile)
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")
Dim objRecordSet: Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & objFile.ParentFolder & "\;" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
objRecordset.Open "SELECT * FROM [" & objFile.Name & "]", objConnection, adOpenStatic, adLockOptimistic, adCmdText
If Err.Number <> 0 Then
Err.Clear
Call Logger(strLogFile, "Error Contacts File Is Already Opened, Quitting Script!", False)
End If
'Connect to AD and Get Contacts Container
Const ADS_SCOPE_SUBTREE = 2
Dim objConnection2: Set objConnection2 = CreateObject("ADODB.Connection")
Dim objCommand: Set objCommand = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection2
objCommand.Properties("Page Size") = 1000 'Override the Return 1000 Results Default
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 'Include Sub OU's
objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strContactsDN & "'"
Dim objRecordset2: Set objRecordSet2 = objCommand.Execute
If Not objRecordSet2.RecordCount > 0 Then
Call Logger(strLogFile, "Error Contacts Container Doesn't Exist, Quitting Script!", False)
Exit Sub
End If
Dim objContainer: Set objContainer = GetObject(objRecordSet2.Fields("AdsPath").Value)
Dim strResult
Dim blnAttributeFound
Dim objContact, cFName, cLName, cInitials, cOffice, cWebpage
Dim cEmail, cEmailAlias
Dim cJobTitle, cDepartment, cCompany
Dim cStreet, cCity, cState, cZip, cCountry, cPOBox
Dim cHomePhone, cOtherHomePhone, cPager, cMobile, cFax, cOtherFax, cIPPhone, cOtherIPPhone, cTelephone, cOtherTelephone, cNotes
Do Until objRecordset.EOF
'Set Contact CN
strResult = objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name") & ":"
Set objContact = objContainer.Create("Contact","CN=" & objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name"))
'General Attributes (Telephone/Other Telephone Under Telephones Attributes and E-mail Under Email Attributes
If Not IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then
cFName = objRecordset.Fields.Item("First Name")
cLName = objRecordset.Fields.Item("Last Name")
objContact.Put "givenName", cFName
objContact.Put "SN", cLName
objContact.Put "displayname", cFName & " " & cLName
Elseif Not IsNull(objRecordset.Fields.Item("First Name")) AND IsNull(objRecordset.Fields.Item("Last Name")) Then
cFName = objRecordset.Fields.Item("First Name")
objContact.Put "givenName", cFName
objContact.Put "displayname", cFName
Elseif IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then
cLName = objRecordset.Fields.Item("Last Name")
objContact.Put "SN", cLName
objContact.Put "displayname", cLName
End If
If Not IsNull(objRecordset.Fields.Item("Initials")) Then
cInitials = objRecordset.Fields.Item("Initials")
objContact.Put "initials", cInitials
End If
If Not IsNull(objRecordset.Fields.Item("Office Location")) Then
cOffice = objRecordset.Fields.Item("Office Location")
objContact.Put "physicalDeliveryOfficeName", cOffice
End If
If Not IsNull(objRecordset.Fields.Item("Web Page")) Then
cWebpage = objRecordset.Fields.Item("Web Page")
objContact.Put "wWWHomePage", cWebpage
End If
objContact.SetInfo
If Err.Number <> 0 Then
Err.Clear
strResult = strResult & "ERROR,ERROR,ERROR,ERROR,ERROR"
Else
strResult = strResult & "SUCCESS,"
'Email Attributes (Assumes First Email)
blnAttributeFound = False
If Not IsNull(objRecordset.Fields.Item("E-mail Address")) Then
blnAttributeFound = True
cEmail = objRecordset.Fields.Item("E-mail Address")
objContact.Put "Mail", cEmail
objContact.MailEnable cEmail
End If
If Not IsNull(objRecordset.Fields.Item("E-mail Display Name")) Then
blnAttributeFound = True
cEmailAlias = objRecordset.Fields.Item("E-mail Display Name")
objContact.Put "mailNickname", cEmailAlias
objContact.MailEnable cEmail
End If
If blnAttributeFound = True Then
objContact.SetInfo
End If
If Err.Number <> 0 Then
Err.Clear
strResult = strResult & "ERROR,"
Else
strResult = strResult & "SUCCESS,"
End If
'Organization Attributes
blnAttributeFound = False
If Not IsNull(objRecordset.Fields.Item("Job Title")) Then
blnAttributeFound = True
cJobTitle = objRecordset.Fields.Item("Job Title")
objContact.Put "title", cJobTitle
End If
If Not IsNull(objRecordset.Fields.Item("Department")) Then
blnAttributeFound = True
cDepartment = objRecordset.Fields.Item("Department")
objContact.Put "department", cDepartment
End If
If Not IsNull(objRecordset.Fields.Item("Company")) Then
blnAttributeFound = True
cCompany = objRecordset.Fields.Item("Company")
objContact.Put "company", cCompany
End If
If blnAttributeFound = True Then
objContact.SetInfo
End If
If Err.Number <> 0 Then
Err.Clear
strResult = strResult & "ERROR,"
Else
strResult = strResult & "SUCCESS,"
End If
'Address Attributes (Add Variable to choose business, home, or other)
blnAttributeFound = False
Select Case UCase(UserType)
Case "BUSINESS"
If Not IsNull(objRecordset.Fields.Item("Business Street")) Then
blnAttributeFound = True
cStreet = objRecordset.Fields.Item("Business Street")
If Not IsNull(objRecordset.Fields.Item("Business Street 2")) Then
cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 2")
End If
If Not IsNull(objRecordset.Fields.Item("Business Street 3")) Then
cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 3")
End If
objContact.Put "streetAddress", cStreet
End If
If Not IsNull(objRecordset.Fields.Item("Business City")) Then
blnAttributeFound = True
cCity = objRecordset.Fields.Item("Business City")
objContact.Put "l", cCity
End If
If Not IsNull(objRecordset.Fields.Item("Business State")) Then
blnAttributeFound = True
cState = objRecordset.Fields.Item("Business State")
objContact.Put "st", cState
End If
If Not IsNull(objRecordset.Fields.Item("Business Postal Code")) Then
blnAttributeFound = True
cZip = objRecordset.Fields.Item("Business Postal Code")
objContact.Put "postalCode", cZip
End If
If Not IsNull(objRecordset.Fields.Item("Business Country/Region")) Then
blnAttributeFound = True
cCountry = objRecordset.Fields.Item("Business Country/Region")
objContact.Put "co", cCountry 'Note: use co to choose Country Name in ISO3166
End If
If Not IsNull(objRecordset.Fields.Item("Business Address PO Box")) Then
blnAttributeFound = True
cPOBox = objRecordset.Fields.Item("Business Address PO Box")
objContact.Put "postOfficeBox", cPOBox
End If
Case "HOME"
If Not IsNull(objRecordset.Fields.Item("Home Street")) Then
blnAttributeFound = True
cStreet = objRecordset.Fields.Item("Home Street")
If Not IsNull(objRecordset.Fields.Item("Home Street 2")) Then
cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 2")
End If
If Not IsNull(objRecordset.Fields.Item("Home Street 3")) Then
cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 3")
End If
objContact.Put "streetAddress", cStreet
End If
If Not IsNull(objRecordset.Fields.Item("Home City")) Then
blnAttributeFound = True
cCity = objRecordset.Fields.Item("Home City")
objContact.Put "l", cCity
End If
If Not IsNull(objRecordset.Fields.Item("Home State")) Then
blnAttributeFound = True
cState = objRecordset.Fields.Item("Home State")
objContact.Put "st", cState
End If
If Not IsNull(objRecordset.Fields.Item("Home Postal Code")) Then
blnAttributeFound = True
cZip = objRecordset.Fields.Item("Home Postal Code")
objContact.Put "postalCode", cZip
End If
If Not IsNull(objRecordset.Fields.Item("Home Country/Region")) Then
blnAttributeFound = True
cCountry = objRecordset.Fields.Item("Home Country/Region")
objContact.Put "co", cCountry 'Note: use co to choose Country Name in ISO3166
End If
If Not IsNull(objRecordset.Fields.Item("Home Address PO Box")) Then
blnAttributeFound = True
cPOBox = objRecordset.Fields.Item("Home Address PO Box")
objContact.Put "postOfficeBox", cPOBox
End If
Case "OTHER"
If Not IsNull(objRecordset.Fields.Item("Other Street")) Then
blnAttributeFound = True
cStreet = objRecordset.Fields.Item("Other Street")
If Not IsNull(objRecordset.Fields.Item("Other Street 2")) Then
cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 2")
End If
If Not IsNull(objRecordset.Fields.Item("Other Street 3")) Then
cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 3")
End If
objContact.Put "streetAddress", cStreet
End If
If Not IsNull(objRecordset.Fields.Item("Other City")) Then
blnAttributeFound = True
cCity = objRecordset.Fields.Item("Other City")
objContact.Put "l", cCity
End If
If Not IsNull(objRecordset.Fields.Item("Other State")) Then
blnAttributeFound = True
cState = objRecordset.Fields.Item("Other State")
objContact.Put "st", cState
End If
If Not IsNull(objRecordset.Fields.Item("Other Postal Code")) Then
blnAttributeFound = True
cZip = objRecordset.Fields.Item("Other Postal Code")
objContact.Put "postalCode", cZip
End If
If Not IsNull(objRecordset.Fields.Item("Other Country/Region")) Then
blnAttributeFound = True
cCountry = objRecordset.Fields.Item("Other Country/Region")
objContact.Put "co", cCountry 'Note: use co to choose Country Name in ISO3166
End If
If Not IsNull(objRecordset.Fields.Item("Other Address PO Box")) Then
blnAttributeFound = True
cPOBox = objRecordset.Fields.Item("Other Address PO Box")
objContact.Put "postOfficeBox", cPOBox
End If
End Select
If blnAttributeFound = True Then
objContact.SetInfo
End If
If Err.Number <> 0 Then
Err.Clear
strResult = strResult & "ERROR,"
Else
strResult = strResult & "SUCCESS,"
End If
'Telephone Attributes (Add Variable to choose business, home or other)
blnAttributeFound = False
If Not IsNull(objRecordset.Fields.Item("Home Phone")) Then
blnAttributeFound = True
cHomePhone = objRecordset.Fields.Item("Home Phone")
objContact.Put "homePhone", cHomePhone
End If
If Not IsNull(objRecordset.Fields.Item("Home Phone 2")) Then
blnAttributeFound = True
cOtherHomePhone = objRecordset.Fields.Item("Home Phone 2")
objContact.PutEx 3, "otherHomePhone", Array(cOtherHomePhone)
End If
If Not IsNull(objRecordset.Fields.Item("Pager")) Then
blnAttributeFound = True
cPager = objRecordset.Fields.Item("Pager")
objContact.Put "pager", cPager
End If
If Not IsNull(objRecordset.Fields.Item("Mobile Phone")) Then
blnAttributeFound = True
cMobile = objRecordset.Fields.Item("Mobile Phone")
objContact.Put "mobile", cMobile
End If
If Not IsNull(objRecordset.Fields.Item("Business Fax")) Then
blnAttributeFound = True
cFax = objRecordset.Fields.Item("Business Fax")
objContact.Put "facsimileTelephoneNumber", cFax
End If
If Not IsNull(objRecordset.Fields.Item("Home Fax")) Then
blnAttributeFound = True
cOtherFax = objRecordset.Fields.Item("Home Fax")
objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)
End If
If Not IsNull(objRecordset.Fields.Item("Other Fax")) Then
blnAttributeFound = True
cOtherFax = objRecordset.Fields.Item("Other Fax")
objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)
End If
If Not IsNull(objRecordset.Fields.Item("Business Phone")) Then
blnAttributeFound = True
cIPPhone = objRecordset.Fields.Item("Business Phone")
objContact.Put "ipPhone", cIPPhone
End If
If Not IsNull(objRecordset.Fields.Item("Business Phone 2")) Then
blnAttributeFound = True
cOtherIPPhone = objRecordset.Fields.Item("Business Phone 2")
objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)
End If
If Not IsNull(objRecordset.Fields.Item("Company Main Phone")) Then
blnAttributeFound = True
cOtherIPPhone = objRecordset.Fields.Item("Company Main Phone")
objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)
End If
If Not IsNull(objRecordset.Fields.Item("Primary Phone")) Then
blnAttributeFound = True
cTelephone = objRecordset.Fields.Item("Primary Phone")
objContact.Put "telephoneNumber", cTelephone
End If
If Not IsNull(objRecordset.Fields.Item("Other Phone")) Then
blnAttributeFound = True
cOtherTelephone = objRecordset.Fields.Item("Other Phone")
objContact.Put "otherTelephone", cOtherTelephone
End If
If Not IsNull(objRecordset.Fields.Item("Notes")) Then
blnAttributeFound = True
cNotes = objRecordset.Fields.Item("Notes")
objContact.Put "info", cNotes
End If
If blnAttributeFound = True Then
objContact.SetInfo
End If
If Err.Number <> 0 Then
Err.Clear
strResult = strResult & "ERROR"
Else
strResult = strResult & "SUCCESS"
End If
End If
'Log Results
Call Logger(strLogFile, strResult, False)
objRecordset.MoveNext
Loop
objRecordset.Close
objRecordset2.Close
On Error Goto 0 'End Error Handling
End Sub
Private Sub Logger(fileName, logMessage, blnNewLog)
On Error Resume Next
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
Dim logName
If InStr(1,fileName,"\",1) > 0 Then
logName = fileName
If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
If Not objFSO.FolderExists(logName) Then
If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
objFSO.CreateFolder logName 'Create Folder In Current Path
Exit Sub
Else
Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
Exit Sub
End If
End If
Else
If Not objFSO.FileExists(logName) Then
If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
End If
End If
End If
End If
Else
logName = scriptPath & fileName
End If
Dim logFile
If blnNewLog = True Then
Set logFile = objFSO.CreateTextFile(logName, True)
Else
If objFSO.FileExists(logName) Then
Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
Else
Set logFile = objFSO.CreateTextFile(logName, True)
End If
End If
logFile.WriteLine logMessage
logFile.Close
Set objFSO = Nothing
On Error Goto 0
End Sub
