bsharath
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=Countri es," ' 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("DefaultNa mingContex t"))
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Applic ation")
Set objSheet = objExcel.Workbooks.Open(st rPathExcel )
' 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).V alue
Strmobile = objExcel.cells(intRow, 7).Value
' Build the actual contacts.
Set objContact = objContainer.Create("Conta ct","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 "physicalDeliveryOfficeNam e", 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
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=Countri
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("DefaultNa
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Applic
Set objSheet = objExcel.Workbooks.Open(st
' Here is the loop that cycles through the cells
Do Until (objExcel.Cells(intRow,1).
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).V
Strmobile = objExcel.cells(intRow, 7).Value
' Build the actual contacts.
Set objContact = objContainer.Create("Conta
objContact.Put "Mail", strEmail
objContact.Put "givenName", strFirst
objContact.Put "sn", strLast
objContact.Put "mailNickname", Cstr(strAlias)
objContact.Put "proxyAddresses", "SMTP:" & strEmail
objContact.Put "physicalDeliveryOfficeNam
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Whoops, I left that out! Sorry, put this:
strExcelFile = Replace(WScript.ScriptFull Name, WScript.ScriptName, "") & "Users_and_Contacts_Sharat h.xls"
under this line:
' ******** CONTACTS *************
Regards,
Rob.
strExcelFile = Replace(WScript.ScriptFull
under this line:
' ******** CONTACTS *************
Regards,
Rob.
ASKER
Rob
I get this...
C:\Create Contacts.vbs(34, 7) Microsoft VBScript runtime error: Invalid procedure call or argument: 'Mid'
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.
Name (@domain.com)
do you still need that? What columns do you want to use?
Rob.
ASKER
Thanks for this Rob...
ASKER
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?
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.msExchHideFromA ddressList s = False
above this line:
objContact.SetInfo
or if that doesn't work, then put another
objContact.SetInfo
above the msExchHideFromAddressLists line.
Regards,
Rob.
objContact.msExchHideFromA
above this line:
objContact.SetInfo
or if that doesn't work, then put another
objContact.SetInfo
above the msExchHideFromAddressLists
Regards,
Rob.
ASKER
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
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.msExchHideFromA ddressList s = 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.
objContact.msExchHideFromA
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.
ASKER
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
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.
Is that what you are expecting?
Rob.
ASKER
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.
strAlias = Left(strEmail, InStr(strEmail, "@") - 1)
to this
strAlias = strFirstName & strLastName
Rob.
ASKER
That worked fine now .
The email address has to be created with the SMTP.And see as the pictures posted...
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.FullNa me, 11)) = "wscript.exe" Then
strPath = Wscript.ScriptFullName
strCommand = "%comspec% /k cscript """ & strPath & """"
Set objShell = CreateObject("Wscript.Shel l")
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.ScriptFull Name, WScript.ScriptName, "") & "Users_and_Contacts_Sharat h.xls"
strContactOUPath = "OU=Contacts,OU=TestOU," & objRootLDAP.Get("defaultNa mingContex t")
' 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.Applic ation")
objExcel.Visible = True
objExcel.Workbooks.Open strExcelFile
Set objNetwork = CreateObject("WScript.Netw ork")
strDomainName = objNetwork.UserDomain
For intRow = 2 To objExcel.ActiveSheet.Cells (65536, "A").End(xlUp).Row
strFirstName = Trim(objExcel.ActiveSheet. Cells(intR ow, "A").Value)
strLastName = Trim(objExcel.ActiveSheet. Cells(intR ow, "B").Value)
strFullName = Trim(objExcel.ActiveSheet. Cells(intR ow, "C").Value)
strUserNameHeading = Mid(Trim(objExcel.ActiveSh eet.Cells( 1, "D").Value), InStr(Trim(objExcel.Active Sheet.Cell s(1, "D").Value), "@"),Len(Trim(objExcel.Act iveSheet.C ells(1, "D").Value)) - InStr(Trim(objExcel.Active Sheet.Cell s(1, "D").Value), "@"))
strUserName = Trim(objExcel.ActiveSheet. Cells(intR ow, "D").Value) & strUserNameHeading
strEmail = Trim(objExcel.ActiveSheet. Cells(intR ow, "E").Value)
strDescription = Trim(objExcel.ActiveSheet. Cells(intR ow, "F").Value)
strAlias = strFirstName & strLastName
strOffice = Trim(objExcel.ActiveSheet. Cells(intR ow, "G").Value)
strMobile = Trim(objExcel.ActiveSheet. Cells(intR ow, "H").Value)
strTitle = Trim(objExcel.ActiveSheet. Cells(intR ow, "I").Value)
strDepartment = Trim(objExcel.ActiveSheet. Cells(intR ow, "J").Value)
strCompany = Trim(objExcel.ActiveSheet. Cells(intR ow, "K").Value)
strAddress = Trim(objExcel.ActiveSheet. Cells(intR ow, "L").Value)
strCity = Trim(objExcel.ActiveSheet. Cells(intR ow, "M").Value)
strState = Trim(objExcel.ActiveSheet. Cells(intR ow, "N").Value)
strZipCode = Trim(objExcel.ActiveSheet. Cells(intR ow, "O").Value)
strCountry = Trim(objExcel.ActiveSheet. Cells(intR ow, "P").Value)
strHomePhone = Trim(objExcel.ActiveSheet. Cells(intR ow, "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.Creat e("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 "physicalDeliveryOfficeNam e", 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.msExchHideFromA ddressList s = False
objContact.SetInfo
WScript.Echo "Contact " & strAlias & " created."
End If
End If
Next
WScript.Echo "Done"
objExcel.ActiveWorkbook.Cl ose False
objExcel.Quit
Set objExcel = Nothing
'=========================
Regards,
Rob.
'====================
If LCase(Right(Wscript.FullNa
strPath = Wscript.ScriptFullName
strCommand = "%comspec% /k cscript """ & strPath & """"
Set objShell = CreateObject("Wscript.Shel
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.ScriptFull
strContactOUPath = "OU=Contacts,OU=TestOU," & objRootLDAP.Get("defaultNa
' 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.Applic
objExcel.Visible = True
objExcel.Workbooks.Open strExcelFile
Set objNetwork = CreateObject("WScript.Netw
strDomainName = objNetwork.UserDomain
For intRow = 2 To objExcel.ActiveSheet.Cells
strFirstName = Trim(objExcel.ActiveSheet.
strLastName = Trim(objExcel.ActiveSheet.
strFullName = Trim(objExcel.ActiveSheet.
strUserNameHeading = Mid(Trim(objExcel.ActiveSh
strUserName = Trim(objExcel.ActiveSheet.
strEmail = Trim(objExcel.ActiveSheet.
strDescription = Trim(objExcel.ActiveSheet.
strAlias = strFirstName & strLastName
strOffice = Trim(objExcel.ActiveSheet.
strMobile = Trim(objExcel.ActiveSheet.
strTitle = Trim(objExcel.ActiveSheet.
strDepartment = Trim(objExcel.ActiveSheet.
strCompany = Trim(objExcel.ActiveSheet.
strAddress = Trim(objExcel.ActiveSheet.
strCity = Trim(objExcel.ActiveSheet.
strState = Trim(objExcel.ActiveSheet.
strZipCode = Trim(objExcel.ActiveSheet.
strCountry = Trim(objExcel.ActiveSheet.
strHomePhone = Trim(objExcel.ActiveSheet.
'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.Creat
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 "physicalDeliveryOfficeNam
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.msExchHideFromA
objContact.SetInfo
WScript.Echo "Contact " & strAlias & " created."
End If
End If
Next
WScript.Echo "Done"
objExcel.ActiveWorkbook.Cl
objExcel.Quit
Set objExcel = Nothing
'=========================
Regards,
Rob.
ASKER
I get this message
C:\Create Contacts.vbs(110, 19) (null): A constraint violation occurred.
C:\Create Contacts.vbs(110, 19) (null): A constraint violation occurred.
ASKER
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
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.
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.
ASKER
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.
ASKER
Rob as shown belo when creating manually i get the SMTP shown but not though the script...
Screen-shot21.bmp
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.
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.
objContact.MailEnable "SMTP:" & strEmail
instead.
Rob.
ASKER
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
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
ASKER
I even replaced this
objContact.MailEnable strEmail
with this
objContact.MailEnable "SMTP:" & strEmail
Same error
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.
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.
ASKER
I get this..
C:\Create Contacts.vbs(90, 19) Microsoft VBScript runtime error: Object doesn't
support this property or method: 'objContact.MailEnable'
C:\Create Contacts.vbs(90, 19) Microsoft VBScript runtime error: Object doesn't
support this property or method: 'objContact.MailEnable'
ASKER
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.
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.
ASKER
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.
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.
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.
ASKER
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.
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.
Rob.
ASKER
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 "physicalDeliveryOfficeNam e", strOffice
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 "physicalDeliveryOfficeNam
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 "physicalDeliveryOfficeNam e", 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 "physicalDeliveryOfficeNam e", strOffice
and try it that way, and also uncommenting the top one, and commenting out the second one....
Regards,
Rob.
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 "physicalDeliveryOfficeNam
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 "physicalDeliveryOfficeNam
and try it that way, and also uncommenting the top one, and commenting out the second one....
Regards,
Rob.
ASKER
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
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
ASKER
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.
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.
objContact.Put "mailNickname", Cstr(strAlias)
try this:
objContact.MailEnable strEmail
objContact.Put "internetEncoding",1310720
Regards,
Rob.
ASKER
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'
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.
Rob.
ASKER
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.
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.
ASKER
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
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.Creat e("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 "physicalDeliveryOfficeNam e", 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.msExchHideFromA ddressList s = False
objContact.SetInfo
WScript.Echo "Contact " & strAlias & " created."
End If
Regards,
Rob.
Else
Err.Clear
On Error GoTo 0
' Build the actual Contact.
Set objContact = objContactsContainer.Creat
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 "physicalDeliveryOfficeNam
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.msExchHideFromA
objContact.SetInfo
WScript.Echo "Contact " & strAlias & " created."
End If
Regards,
Rob.
ASKER
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
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
ASKER
What if you change
objContact.Put "targetAddress", strEmail
to
objContact.Put "targetAddress", "SMTP:" & strEmail
Rob.
objContact.Put "targetAddress", strEmail
to
objContact.Put "targetAddress", "SMTP:" & strEmail
Rob.
ASKER
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
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.
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.
ASKER
No Rob this email adress gets created automatically...
ASKER
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
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.msExchHideFromA ddressList s = False
try adding
objContact.showInAddressBo ok = 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.Ge t("default NamingCont ext"), "DC=", "."), 2))
Regards,
Rob.
objContact.msExchHideFromA
try adding
objContact.showInAddressBo
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.Ge
Regards,
Rob.
ASKER
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.Ge t("default NamingCont ext"), "DC=", "."), 2))
Should i place the above line any where...
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.Ge
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.msExchHideFromA ddressList s = False
so remove both of these:
objContact.msExchHideFromA ddressList s = False
objContact.showInAddressBo ok = 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.Ge t("default NamingCont ext"), "DC=", "."), 2))
Regards,
Rob.
objContact.msExchHideFromA
so remove both of these:
objContact.msExchHideFromA
objContact.showInAddressBo
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.Ge
Regards,
Rob.
ASKER
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... :-)
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.
Regards,
Rob.
ASKER
Here is the final code...That works reat...
'====================
If LCase(Right(Wscript.FullNa me, 11)) = "wscript.exe" Then
strPath = Wscript.ScriptFullName
strCommand = "%comspec% /k cscript """ & strPath & """"
Set objShell = CreateObject("Wscript.Shel l")
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.ScriptFull Name, WScript.ScriptName, "") & "Contacts_Sharath.xls"
strContactOUPath = "OU=CS,OU=contacts,OU=User ,OU=Countr ies," & objRootLDAP.Get("defaultNa mingContex t")
' 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.Applic ation")
objExcel.Visible = True
objExcel.Workbooks.Open strExcelFile
Set objNetwork = CreateObject("WScript.Netw ork")
strDomainName = objNetwork.UserDomain
For intRow = 2 To objExcel.ActiveSheet.Cells (65536, "A").End(xlUp).Row
strFirstName = Trim(objExcel.ActiveSheet. Cells(intR ow, "A").Value)
strLastName = Trim(objExcel.ActiveSheet. Cells(intR ow, "B").Value)
strFullName = Trim(objExcel.ActiveSheet. Cells(intR ow, "C").Value)
strUserNameHeading = Mid(Trim(objExcel.ActiveSh eet.Cells( 1, "D").Value), InStr(Trim(objExcel.Active Sheet.Cell s(1, "D").Value), "@"),Len(Trim(objExcel.Act iveSheet.C ells(1, "D").Value)) - InStr(Trim(objExcel.Active Sheet.Cell s(1, "D").Value), "@"))
strUserName = Trim(objExcel.ActiveSheet. Cells(intR ow, "D").Value) & strUserNameHeading
strEmail = Trim(objExcel.ActiveSheet. Cells(intR ow, "E").Value)
strDescription = Trim(objExcel.ActiveSheet. Cells(intR ow, "F").Value)
strAlias = strFirstName & strLastName
strOffice = Trim(objExcel.ActiveSheet. Cells(intR ow, "G").Value)
strMobile = Trim(objExcel.ActiveSheet. Cells(intR ow, "H").Value)
strTitle = Trim(objExcel.ActiveSheet. Cells(intR ow, "I").Value)
strDepartment = Trim(objExcel.ActiveSheet. Cells(intR ow, "J").Value)
strCompany = Trim(objExcel.ActiveSheet. Cells(intR ow, "K").Value)
strAddress = Trim(objExcel.ActiveSheet. Cells(intR ow, "L").Value)
strCity = Trim(objExcel.ActiveSheet. Cells(intR ow, "M").Value)
strState = Trim(objExcel.ActiveSheet. Cells(intR ow, "N").Value)
strZipCode = Trim(objExcel.ActiveSheet. Cells(intR ow, "O").Value)
strCountry = Trim(objExcel.ActiveSheet. Cells(intR ow, "P").Value)
strHomePhone = Trim(objExcel.ActiveSheet. Cells(intR ow, "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.Creat e("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.Ge t("default NamingCont ext"), "DC=", "."), 2))
objContact.SetInfo
If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeNam e", 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.Cl ose False
objExcel.Quit
Set objExcel = Nothing
'=========================
'====================
If LCase(Right(Wscript.FullNa
strPath = Wscript.ScriptFullName
strCommand = "%comspec% /k cscript """ & strPath & """"
Set objShell = CreateObject("Wscript.Shel
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.ScriptFull
strContactOUPath = "OU=CS,OU=contacts,OU=User
' 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.Applic
objExcel.Visible = True
objExcel.Workbooks.Open strExcelFile
Set objNetwork = CreateObject("WScript.Netw
strDomainName = objNetwork.UserDomain
For intRow = 2 To objExcel.ActiveSheet.Cells
strFirstName = Trim(objExcel.ActiveSheet.
strLastName = Trim(objExcel.ActiveSheet.
strFullName = Trim(objExcel.ActiveSheet.
strUserNameHeading = Mid(Trim(objExcel.ActiveSh
strUserName = Trim(objExcel.ActiveSheet.
strEmail = Trim(objExcel.ActiveSheet.
strDescription = Trim(objExcel.ActiveSheet.
strAlias = strFirstName & strLastName
strOffice = Trim(objExcel.ActiveSheet.
strMobile = Trim(objExcel.ActiveSheet.
strTitle = Trim(objExcel.ActiveSheet.
strDepartment = Trim(objExcel.ActiveSheet.
strCompany = Trim(objExcel.ActiveSheet.
strAddress = Trim(objExcel.ActiveSheet.
strCity = Trim(objExcel.ActiveSheet.
strState = Trim(objExcel.ActiveSheet.
strZipCode = Trim(objExcel.ActiveSheet.
strCountry = Trim(objExcel.ActiveSheet.
strHomePhone = Trim(objExcel.ActiveSheet.
'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.Creat
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.Ge
objContact.SetInfo
If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeNam
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.Cl
objExcel.Quit
Set objExcel = Nothing
'=========================
ASKER