Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

Create contacts script not working

Hi,

Here is a script that i got from EE.

Option Explicit
Dim objRootLDAP, objContainer, objContact, objExcel, objSheet
Dim strOU, strContactName, strPathExcel, strEmail
Dim intRow, strYourDescription, strFirst, strLast, strAlias, StrDisplayName, strDescription, stroffice, strmobile

' Set string variables
' Note: Assume an OU called suppliers exists.
strOU = "OU=Contacts,OU=User Accounts,OU=IND,OU=Countries," ' Note the comma
strPathExcel = "C:\CreateContacts.xlsx"
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
   strAlias = objExcel.cells(intRow, 2).Value
   strEmail = objExcel.cells(intRow, 3).Value
   strFirst = objExcel.cells(intRow, 4).Value
   strLast = objExcel.cells(intRow, 5).Value
   Stroffice  = objExcel.cells(intRow,6).Value
   Strmobile  = objExcel.cells(intRow, 7).Value
 
     ' Build the actual contacts.
   Set objContact = objContainer.Create("Contact","cn=" & strContactName)
   objContact.Put "Mail", strEmail
   objContact.Put "givenName", strFirst
   objContact.Put "sn", strLast
   objContact.Put "mailNickname", Cstr(strAlias)
   objContact.Put "proxyAddresses", "SMTP:" & strEmail
   objContact.Put "physicalDeliveryOfficeName", Stroffice
   objContact.Put "mobile", Strmobile
   objContact.SetInfo

intRow = intRow + 1
Loop

Wscript.Echo "Done"
objExcel.Quit

https://www.experts-exchange.com/questions/22901844/Create-contacts-in-ADS-with-the-details-from-the-excel.html?sfQueryTermInfo=1+bsharath+contact+creat

I dont know what but i am not able to create users.No error nor geets created.

Regards
Sharath
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of bsharath

ASKER

Rob in the script where should i mention the xls filename.?
Whoops, I left that out!  Sorry, put this:
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_and_Contacts_Sharath.xls"

under this line:
' ******** CONTACTS *************

Regards,

Rob.
Rob
I get this...
C:\Create Contacts.vbs(34, 7) Microsoft VBScript runtime error: Invalid procedure call or argument: 'Mid'
That's for the username heading.  Remember we had the heading of that column D to be:
Name (@domain.com)

do you still need that?  What columns do you want to use?

Rob.
Thanks for this Rob...
Rob just a general question...

Contacts are created so that users without a login can be seen in the outlook Gal.Am i right?
The users created through scripts are not being seen in the GAL its been 3 days from when i created a contact through the "Users and contacts" script. Still they are not visible.Any contact that i create manuall are seen there.
After i create a mention a external email id to the contacts is that to do any thing?
Try adding this line:

objContact.msExchHideFromAddressLists = False

above this line:
objContact.SetInfo

or if that doesn't work, then put another
objContact.SetInfo
above the msExchHideFromAddressLists line.

Regards,

Rob.
I just checked the users manually but they are not hidden...
Should we create a SMTP email address for it to be seen in the GAL.?

The first screen shot is created by the script and the secound one is manuall .
After creating the contact > Right click go to Exchange tasks > Establish email address > SMTP and the external email id.

ScreenShot013.jpg
ScreenShot014.jpg
The line:
objContact.msExchHideFromAddressLists = False

would just force the user to NOT be hidden from the list.

However, I would have thought that this line from the script:
objContact.Put "proxyAddresses", "SMTP:" & strEmail

would put in that Email field.

Maybe it needs another
objContact.SetInfo

just above that
objContact.Put "proxyAddresses", "SMTP:" & strEmail

Regards,

Rob.
Rob still no luck
In the firstname i give "Raja" in last name its " Kumar"
But in the Alias when i see its "bsharath"
Its taking from the email id i have provided in the email box

The SMTP email should be from column E, and the alias should just be first part of that email address before the @ symbol.

Is that what you are expecting?

Rob.
Yes that's what is happening but the Alias has to be firstname and lastname without space in between...
OK, that's easy, change this
strAlias = Left(strEmail, InStr(strEmail, "@") - 1)

to this
strAlias = strFirstName & strLastName

Rob.
That worked fine now .
The email address has to be created with the SMTP.And see as the pictures posted...
Sharath, see if this works for the SMTP address:

'====================
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
      strPath = Wscript.ScriptFullName
      strCommand = "%comspec% /k cscript  """ & strPath & """"
      Set objShell = CreateObject("Wscript.Shell")
      objShell.Run(strCommand), 1, True
      Wscript.Quit
End If

' Bind to Active Directory.
Set objRootLDAP = GetObject("LDAP://rootDSE")

' CONFIGURATION PARAMETERS FOR THE SCRIPT
' ******** CONTACTS *************
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_and_Contacts_Sharath.xls"
strContactOUPath = "OU=Contacts,OU=TestOU," & objRootLDAP.Get("defaultNamingContext")
' END CONFIGURATION PARAMETERS

Const xlUp = -4162
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_APPEND = 3
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Open strExcelFile

Set objNetwork = CreateObject("WScript.Network")
strDomainName = objNetwork.UserDomain

For intRow = 2 To objExcel.ActiveSheet.Cells(65536, "A").End(xlUp).Row

      strFirstName = Trim(objExcel.ActiveSheet.Cells(intRow, "A").Value)
      strLastName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)
      strFullName = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)
      strUserNameHeading = Mid(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"),Len(Trim(objExcel.ActiveSheet.Cells(1, "D").Value)) - InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"))
      strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "D").Value) & strUserNameHeading
      strEmail = Trim(objExcel.ActiveSheet.Cells(intRow, "E").Value)
      strDescription = Trim(objExcel.ActiveSheet.Cells(intRow, "F").Value)
      strAlias = strFirstName & strLastName
      strOffice = Trim(objExcel.ActiveSheet.Cells(intRow, "G").Value)
      strMobile = Trim(objExcel.ActiveSheet.Cells(intRow, "H").Value)
      strTitle = Trim(objExcel.ActiveSheet.Cells(intRow, "I").Value)
      strDepartment = Trim(objExcel.ActiveSheet.Cells(intRow, "J").Value)
      strCompany = Trim(objExcel.ActiveSheet.Cells(intRow, "K").Value)
      strAddress = Trim(objExcel.ActiveSheet.Cells(intRow, "L").Value)
      strCity = Trim(objExcel.ActiveSheet.Cells(intRow, "M").Value)
      strState = Trim(objExcel.ActiveSheet.Cells(intRow, "N").Value)
      strZipCode = Trim(objExcel.ActiveSheet.Cells(intRow, "O").Value)
      strCountry = Trim(objExcel.ActiveSheet.Cells(intRow, "P").Value)
      strHomePhone = Trim(objExcel.ActiveSheet.Cells(intRow, "Q").Value)
     
      'strFirstName = Trim(Left(strFullName, InStrRev(strFullName, " ") - 1))
      'strLastName = Trim(Mid(strFullName, InStrRev(strFullName, " ") + 1))
           
      If strFullName <> "" And strUserName <> "" Then
           
            WScript.Echo "About to create:" & VbCrLf &_
                  strFullName & VbCrLf &_
                  strFirstName & VbCrLf &_
                  strLastName & VbCrLf & _
                  strUserName & VbCrLf &_
                  strPassword & VbCrLf &_
                  "LDAP://" & strContactOUPath
                 
            ' This will add the user to eg. Domain.Local\Users
            Set objContainer = GetObject("LDAP://" & strContactOUPath)
           
            ' ********** CONTACT CREATION *************
            Set objContactsContainer = GetObject("LDAP://" & strContactOUPath)
           
            ' Check if the contact already exists
            On Error Resume Next
           
            Set objNewContact = GetObject("LDAP://cn=" & strFullName & "," & strContactOUPath)
            If Err.Number = 0 Then
                  WScript.Echo "Contact " & strFullName & " already exists."
                  On Error GoTo 0
            Else
                  Err.Clear
                  On Error GoTo 0
                 
                  ' Build the actual Contact.
                  Set objContact = objContactsContainer.Create("Contact","cn=" & strFullName)
                  objContact.Put "Mail", strEmail
                  objContact.Put "givenName", strFirstName
                  objContact.Put "sn", strLastName
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.SetInfo
                  On Error Resume Next
                  objGroup.PutEx ADS_PROPERTY_CLEAR, "proxyAddresses", 0
                  objContact.SetInfo
                  On Error GoTo 0
                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array(strEmail)
                  'objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)
                  objContact.SetInfo
                  If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice
                  If strDescription <> "" Then objContact.Put "description", strDescription
                  If strMobile <> "" Then objContact.Put "mobile", strMobile
                  If strTitle <> "" Then objContact.Put "title", strTitle
                  If strDepartment <> "" Then objContact.Put "department", strDepartment
                  If strCompany <> "" Then objContact.Put "company", strCompany
                  If strAddress <> "" Then objContact.Put "streetAddress", strAddress
                  If strCity <> "" Then objContact.Put "l", strCity
                  If strState <> "" Then objContact.Put "st", strState
                  If strZipCode <> "" Then objContact.Put "postalCode", strZipCode
                  ' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements
                  If strCountry <> "" Then objContact.Put "c", strCountry
                  If strHomePhone <> "" Then objContact.Put "homePhone", strHomePhone
                  objContact.msExchHideFromAddressLists = False
                  objContact.SetInfo
                  WScript.Echo "Contact " & strAlias & " created."
            End If
      End If
Next

WScript.Echo "Done"
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing
'=========================

Regards,

Rob.
I get this message

C:\Create Contacts.vbs(110, 19) (null): A constraint violation occurred.
Attached a file.
Rob i am getting the exchange option(The tabs) but in the Email the SMTP email address is not seen.

ScreenShot016.jpg
For that constraint to occur, I think it is because of the other properties, not the email one, so try making everything after the Office column empty, just to test.

For the SMTP address, try commenting this line:
                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array(strEmail)
and uncommenting this line
                  'objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)

Regards,

Rob.
First time i get the error as mentioned above and the secound time it creates the contact.But still does not show the SMTP addess on the email box in the exchange general tab.
Rob as shown belo when creating manually i get the SMTP shown but not though the script...
Screen-shot21.bmp
Try putting this:
objContact.MailEnable strEmail

underneath this line:
objContact.Put "mailNickname", Cstr(strAlias)

I don't have Exchange, so I can't test this bit....

Regards,

Rob.
You can also try
objContact.MailEnable "SMTP:" & strEmail
instead.

Rob.
I get this...
C:\Create Contacts.vbs(88, 1) Microsoft VBScript runtime error: Object doesn't s
upport this property or method: 'objContact.MailEnable'

>>
You can also try
objContact.MailEnable "SMTP:" & strEmail
instead.

Do you mean insted of this...
objContact.MailEnable strEmail
I even replaced this
objContact.MailEnable strEmail
with this
objContact.MailEnable "SMTP:" & strEmail
Same error
Hmmm, where you put that
objContact.MailEnable strEmail
or
objContact.MailEnable "SMTP:" & strEmail
if you changed it....

you should have this:

                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.MailEnable strEmail
                  objContact.SetInfo
                  On Error Resume Next

Try changing that to:

                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.SetInfo
                  objContact.MailEnable strEmail
                  On Error Resume Next

Regards,

Rob.
I get this..
C:\Create Contacts.vbs(90, 19) Microsoft VBScript runtime error: Object doesn't
support this property or method: 'objContact.MailEnable'

Rob even though i get the error the contact is created but without the SMTP on the Email box.

According to this:
http://techtasks.com/code/viewbookcode/215

the code that we have to MailEnable the contact:
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.SetInfo
                  objContact.MailEnable strEmail
                  On Error Resume Next

should work.....does your computer have Exchange Administration components installed? I'm not sure whether it needs to or not....have you tried directly from the Exchange server?

Regards,

Rob.
Yes Rob the tools are installed.
I even checked on ESM and other dc's
In the Email address tab the SMTP is created fine but not in the Exchange general > Email box the email address is not displayed.
Instead of
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.SetInfo
                  objContact.MailEnable strEmail
                  On Error Resume Next

try
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.SetInfo
                  objContact.Put "SMTPEmail", strEmail
                  On Error Resume Next

Regards,

Rob.
When i run for the first time i get this...
C:\Create Contacts.vbs(99, 19) (null): The specified directory service attribute
 or value does not exist.

Then when i run the same script again i get this...
Contact Raja Ramesh already exists.
Done

Rob i need a contact to have an external email address not an address created with the company name.
Like my name with a hotmail or yahoo email address.So that everyone can see my contact in the GAL when mail send i will get it on my yahoo or hotmail account.
Which is your line 99 at the moment?

Rob.
This is in line 99
     objContact.SetInfo


'objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array(strEmail)
                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)
                  objContact.SetInfo
                  If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice

Above this:
Const ADS_PROPERTY_APPEND = 3

put this
Const ADS_PROPERTY_UPDATE = 2

and then change this:
                  'objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array(strEmail)
                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)
                  objContact.SetInfo
                  If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice

To this
                  'objContact.PutEx ADS_PROPERTY_UPDATE, "proxyAddresses", Array(strEmail)
                  objContact.PutEx ADS_PROPERTY_UPDATE, "proxyAddresses", Array("SMTP:" & strEmail)
                  objContact.SetInfo
                  If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice

and try it that way, and also uncommenting the top one, and commenting out the second one....

Regards,

Rob.
Rob with the above changes i am geting my company email id
In excel i have the hotmail adress but here after creation it creates a
Test.test@companyname.com
I still get the error on the first run

Rob once i run the script and see the users General tab > Email i can see the email address mentioned by me in the excel.After 5 min it changes to the username.Company .com address. I think one part is over riding the other in the script...
Under this:
   objContact.Put "mailNickname", Cstr(strAlias)
Try putting this:
   objContact.Put "targetAddress", strEmail

Regards,

Rob.
Also, under this:
objContact.Put "mailNickname", Cstr(strAlias)

try this:
objContact.MailEnable strEmail
objContact.Put "internetEncoding",1310720

Regards,

Rob.
I get this Rob..

C:\Create Contacts.vbs(90, 1) Microsoft VBScript runtime error: Object doesn't s
upport this property or method: 'objContact.MailEnable'
I am surprised that the MailEnable method is unsupported....which version of Exchange Server are you using?

Rob.
Exchange 2003...
OK, so instead of MailEnable (as I said, I can't test this) I have read that you need:
                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.Put "targetAddress", strEmail
                  objContact.SetInfo

Apparently, those are the three elements you need to use to "mail enable" a contact.....

Regards,

Rob.
Now i get this Rob..

C:\Create Contacts.vbs(110, 19) (null): The specified directory service attribut
e or value does not exist.

I have changed this line to this.Is this correct.?

MailEnable
to
objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.Put "targetAddress", strEmail
                  objContact.SetInfo
OK, here's the code from the Else above all that, to the End If


            Else
                  Err.Clear
                  On Error GoTo 0
                 
                  ' Build the actual Contact.
                  Set objContact = objContactsContainer.Create("Contact","cn=" & strFullName)
                  objContact.Put "Mail", strEmail
                  objContact.Put "givenName", strFirstName
                  objContact.Put "sn", strLastName
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.Put "targetAddress", strEmail
                  On Error Resume Next
                  objGroup.PutEx ADS_PROPERTY_CLEAR, "proxyAddresses", 0
                  objContact.SetInfo
                  On Error GoTo 0
                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)
                  objContact.SetInfo
                  If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice
                  If strDescription <> "" Then objContact.Put "description", strDescription
                  If strMobile <> "" Then objContact.Put "mobile", strMobile
                  If strTitle <> "" Then objContact.Put "title", strTitle
                  If strDepartment <> "" Then objContact.Put "department", strDepartment
                  If strCompany <> "" Then objContact.Put "company", strCompany
                  If strAddress <> "" Then objContact.Put "streetAddress", strAddress
                  If strCity <> "" Then objContact.Put "l", strCity
                  If strState <> "" Then objContact.Put "st", strState
                  If strZipCode <> "" Then objContact.Put "postalCode", strZipCode
                  ' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements
                  If strCountry <> "" Then objContact.Put "c", strCountry
                  If strHomePhone <> "" Then objContact.Put "homePhone", strHomePhone
                  objContact.msExchHideFromAddressLists = False
                  objContact.SetInfo
                  WScript.Echo "Contact " & strAlias & " created."
            End If


Regards,

Rob.
Rob i think we are close by..

I have attached 2 screen shots in the first one the "SMTP:" is missing before the email address.
And in the "Email address tab" the company SMTP is missing.
ScreenShot014.jpg
ScreenShot017.jpg
The script create contacts look like this...
ScreenShot019.jpg
ScreenShot020.jpg
What if you change
objContact.Put "targetAddress", strEmail
to
objContact.Put "targetAddress", "SMTP:" & strEmail

Rob.
Now i get the SMTP in the "Exchange general tab" but not the company provided email address in the  "Email address"
SMTP  Username@company.co.in
So does that mean you want two email addresses on the Email Addresses tab?  Then I think you'll have to change this:
objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)

to add a second email address, but do you have a second address in the Excel file?

objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & "otheraddress@domain.com")

Regards,

Rob.
No Rob this email adress gets created automatically...
If thats not created also i have no problem the main issue is the contact is not visible in the GAL.
Even after force relicate and even downloaded the Gal data locally

I am able to add the contact to a distribution list and see that distribution list in the GAL and even can see this contact as a memember of the Distribution group in the GAL.When a mail sent i am able to receive the mail too.
But not able to see the contact in the GAL
Hmmm, under
objContact.msExchHideFromAddressLists = False

try adding
objContact.showInAddressBook = True

And I'm not sure that the address gets created automatically for a "contact" when it's done via scripting.  My assumption is that when you create it manually, it's automatically added to the proxyAddresses array by the alias and the default domain name.....so we could use:

objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & strAlias & "@" & Mid(Replace(objRootLDAP.Get("defaultNamingContext"), "DC=", "."), 2))

Regards,

Rob.
I get this Rob..
C:\Create Contacts.vbs(111, 19) (null): A constraint violation occurred.
But now there is a improvement i am able to see the contact in the GAL...

But the description and other details are not updating....


objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & strAlias & "@" & Mid(Replace(objRootLDAP.Get("defaultNamingContext"), "DC=", "."), 2))


Should i place the above line any where...
Hmmm, that error means the showInAddressBook property doesn't exist, however, seeing as the user is then visible in the GAL, maybe this line should not even be there either:
objContact.msExchHideFromAddressLists = False

so remove both of these:
objContact.msExchHideFromAddressLists = False
objContact.showInAddressBook = True

and yes, replace this:
objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)
with this
objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & strAlias & "@" & Mid(Replace(objRootLDAP.Get("defaultNamingContext"), "DC=", "."), 2))

Regards,

Rob.
Excellent Rob thanks this works fine now.

All the options are set.Able to see in Gal.I have sent a mail and gets to the id correctly.

Can you add the same code on the 'Users and contacts" post please...

Appretiate for your patience on this Question... :-)

Wow! OK then. Just so I get the right code ;-P, can you please post the code that you have that correctly creates a contact to here?

Regards,

Rob.
Here is the final code...That works reat...

'====================
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
      strPath = Wscript.ScriptFullName
      strCommand = "%comspec% /k cscript  """ & strPath & """"
      Set objShell = CreateObject("Wscript.Shell")
      objShell.Run(strCommand), 1, True
      Wscript.Quit
End If

' Bind to Active Directory.
Set objRootLDAP = GetObject("LDAP://rootDSE")

' CONFIGURATION PARAMETERS FOR THE SCRIPT
' ******** CONTACTS *************
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Contacts_Sharath.xls"
strContactOUPath = "OU=CS,OU=contacts,OU=User,OU=Countries," & objRootLDAP.Get("defaultNamingContext")
' END CONFIGURATION PARAMETERS

Const xlUp = -4162
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_APPEND = 3
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Open strExcelFile

Set objNetwork = CreateObject("WScript.Network")
strDomainName = objNetwork.UserDomain

For intRow = 2 To objExcel.ActiveSheet.Cells(65536, "A").End(xlUp).Row

      strFirstName = Trim(objExcel.ActiveSheet.Cells(intRow, "A").Value)
      strLastName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)
      strFullName = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)
      strUserNameHeading = Mid(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"),Len(Trim(objExcel.ActiveSheet.Cells(1, "D").Value)) - InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"))
      strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "D").Value) & strUserNameHeading
      strEmail = Trim(objExcel.ActiveSheet.Cells(intRow, "E").Value)
      strDescription = Trim(objExcel.ActiveSheet.Cells(intRow, "F").Value)
      strAlias = strFirstName & strLastName
      strOffice = Trim(objExcel.ActiveSheet.Cells(intRow, "G").Value)
      strMobile = Trim(objExcel.ActiveSheet.Cells(intRow, "H").Value)
      strTitle = Trim(objExcel.ActiveSheet.Cells(intRow, "I").Value)
      strDepartment = Trim(objExcel.ActiveSheet.Cells(intRow, "J").Value)
      strCompany = Trim(objExcel.ActiveSheet.Cells(intRow, "K").Value)
      strAddress = Trim(objExcel.ActiveSheet.Cells(intRow, "L").Value)
      strCity = Trim(objExcel.ActiveSheet.Cells(intRow, "M").Value)
      strState = Trim(objExcel.ActiveSheet.Cells(intRow, "N").Value)
      strZipCode = Trim(objExcel.ActiveSheet.Cells(intRow, "O").Value)
      strCountry = Trim(objExcel.ActiveSheet.Cells(intRow, "P").Value)
      strHomePhone = Trim(objExcel.ActiveSheet.Cells(intRow, "Q").Value)
     
      'strFirstName = Trim(Left(strFullName, InStrRev(strFullName, " ") - 1))
      'strLastName = Trim(Mid(strFullName, InStrRev(strFullName, " ") + 1))
           
      If strFullName <> "" And strUserName <> "" Then
           
            WScript.Echo "About to create:" & VbCrLf &_
                  strFullName & VbCrLf &_
                  strFirstName & VbCrLf &_
                  strLastName & VbCrLf & _
                  strUserName & VbCrLf &_
                  strPassword & VbCrLf &_
                  "LDAP://" & strContactOUPath
                 
            ' This will add the user to eg. Domain.Local\Users
            Set objContainer = GetObject("LDAP://" & strContactOUPath)
           
            ' ********** CONTACT CREATION *************
            Set objContactsContainer = GetObject("LDAP://" & strContactOUPath)
           
            ' Check if the contact already exists
            On Error Resume Next
           
            Set objNewContact = GetObject("LDAP://cn=" & strFullName & "," & strContactOUPath)
            If Err.Number = 0 Then
                  WScript.Echo "Contact " & strFullName & " already exists."
                  On Error GoTo 0
               Else
                  Err.Clear
                  On Error GoTo 0
                 
                  ' Build the actual Contact.
                  Set objContact = objContactsContainer.Create("Contact","cn=" & strFullName)
                  objContact.Put "Mail", strEmail
                  objContact.Put "givenName", strFirstName
                  objContact.Put "sn", strLastName
                  objContact.Put "mailNickname", Cstr(strAlias)
                  objContact.Put "targetAddress", "SMTP:" & strEmail
                  On Error Resume Next
                  objGroup.PutEx ADS_PROPERTY_CLEAR, "proxyAddresses", 0
                  objContact.SetInfo
                  On Error GoTo 0
                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & strAlias & "@" & Mid(Replace(objRootLDAP.Get("defaultNamingContext"), "DC=", "."), 2))

                  objContact.SetInfo
                  If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice
                  If strDescription <> "" Then objContact.Put "description", strDescription
                  If strMobile <> "" Then objContact.Put "mobile", strMobile
                  If strTitle <> "" Then objContact.Put "title", strTitle
                  If strDepartment <> "" Then objContact.Put "department", strDepartment
                  If strCompany <> "" Then objContact.Put "company", strCompany
                  If strAddress <> "" Then objContact.Put "streetAddress", strAddress
                  If strCity <> "" Then objContact.Put "l", strCity
                  If strState <> "" Then objContact.Put "st", strState
                  If strZipCode <> "" Then objContact.Put "postalCode", strZipCode
                  ' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements
                  If strCountry <> "" Then objContact.Put "c", strCountry
                  If strHomePhone <> "" Then objContact.Put "homePhone", strHomePhone
                 
                  objContact.SetInfo
                  WScript.Echo "Contact " & strAlias & " created."
            End If
      End If
Next

WScript.Echo "Done"
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing
'=========================