'========================================================================= ' ConvertOutlookContactsToAD.vbs ' VERSION: 1.0 ' AUTHOR: Brian Steinmeyer ' EMAIL: [email protected] ' WEB: https://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
