1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 |
'========================================================================= ' 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 |