Bulk Contact Import Script

[n3tw0rkadm1n1strat0r]

I need a little help with this script...it seems that if a cell is blank, it error's out and stops the script. Also, if the contact already exists it errors out...does anyone know how to fix this?

Option Explicit
Dim objRootLDAP, objContainer, objContact, objExcel, objSheet
Dim strOU, strPathExcel, intRow, strYourDescription
Dim strContactName, strFirst, strMiddle, strLast, strDep, strHomePhone
Dim strMobilePhone, strFax, strCity, strZip, strState, strEmail, strTitle, strMemberOf
Dim strOfficePhone, strStreet, strCompany, strTitle2, strStreet2, strMailEnable, strAlias, strTargetAddress

strOU = "OU=GP Test ," ' Note the comma
strPathExcel = "C:\Documents and Settings\ekrengel\Desktop\Contact Excel\SampleImportFile.xls"
strYourDescription = "Contact's"
intRow = 2 ' Row 1 contains headings

' Section to bind to Active Directory
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU _
& objRootLDAP.Get("DefaultNamingContext"))

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSheet = objExcel.Workbooks.Open(strPathExcel)

' Here is the loop that cycles through the cells
Do Until (objExcel.Cells(intRow,1).Value) = ""
   
strContactName = objExcel.Cells(intRow, 1).Value
strFirst = objExcel.cells(intRow, 2).Value
strMiddle = objExcel.cells(intRow, 3).Value
strLast = objExcel.cells(intRow, 4).Value
strDep = objExcel.cells(intRow, 5).Value
strHomePhone = objExcel.cells(intRow, 6).Value
strMobilePhone = objExcel.cells(intRow, 7).Value
strFax = objExcel.cells(intRow, 8).Value
strCity = objExcel.cells(intRow, 9).Value
strZip = objExcel.cells(intRow, 10).Value
strState = objExcel.cells(intRow, 11).Value
strEmail = objExcel.cells(intRow, 12).Value
strTitle = objExcel.cells(intRow, 13).Value
strMemberOf = objExcel.cells(intRow, 14).Value
strOfficePhone = objExcel.cells(intRow, 15).Value
strStreet = objExcel.cells(intRow, 16).Value
strCompany = objExcel.cells(intRow, 17).Value
strTitle2 = objExcel.cells(intRow, 18).Value
strStreet2 = objExcel.cells(intRow, 19).Value
strMailEnable = objExcel.cells(intRow, 20).Value
strAlias = objExcel.cells(intRow, 21).Value
strTargetAddress = objExcel.cells(intRow, 22).Value
 
Set objContact = objContainer.Create("Contact",_
   "cn=" & strContactName)

objContact.Put "givenName", strFirst
objContact.Put "initials", strMiddle
objContact.Put "sn", strLast
objContact.Put "department", strDep
objContact.Put "homePhone", strHomePhone
objContact.Put "mobile", strMobilePhone
objContact.Put "facsimileTelephoneNumber", strFax
objContact.Put "l", strCity
objContact.Put "postalCode", strZip
objContact.Put "c", strState
objContact.Put "mail", strEmail
objContact.Put "title", strTitle
objContact.Put "memberOf", strMemberOf
objContact.Put "telephoneNumber", strOfficePhone
objContact.Put "st", strStreet
objContact.Put "company", strCompany
objContact.Put "description", strTitle2
objContact.Put "streetAddress", strStreet2
objContact.Put "EnableExchangeMail", strMailEnable
objContact.Put "mailNickname", strAlias
objContact.Put "targetAddress", strTargetAddress
objContact.SetInfo

intRow = intRow + 1
Loop
objExcel.Quit

msgbox "Contacts are now added!"

WScript.Quit

 

[n3tw0rkadm1n1strat0r]

I've tried using "On Error Resume Next"...but that doesn't really skip it. It completes the script with that but it doesn't put the contact in AD.

 

[markdmac]

Your code is tellign the script to stop if it finds a blank cell:

Do Until (objExcel.Cells(intRow,1).Value) = ""

You need to clean up your source information or use another method to stop script execution.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[n3tw0rkadm1n1strat0r]

Yeah but thats only for the first row, which is the contact name...so if there are no more contacts the the script stops...makes sense to me. Anyway...I've messed around with this and gotten most of it to work.

This works for blanks cells you might have, other than first cell which will be the contact name to stop the script:

if not len(strFirst) = 0 then
objContact.Put "givenName", strFirst
end if

But I still do not know what to do if the contact already exists....

 

[markdmac]

Use On Error Resume Next to allow the script to continue even if a contact already exists.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[n3tw0rkadm1n1strat0r]

Thanks that works.