?
Solved

Need a script to add contacts to AD from either a txt file or cvs or excel

Posted on 2008-02-12
28
Medium Priority
?
903 Views
Last Modified: 2012-06-21
hello I am looking for a script to add contacts to AD from a txt. cvs. or excel file.

i am very new to this and it is a little confusing I would appriciat the help.

thank you in advance.
0
Comment
Question by:ZJY0021
  • 15
  • 13
28 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 20878716
Hi, this may look long-winded, but it seems pretty accurate...try this:
http://www.experts-exchange.com/Programming/Languages/Scripting/Q_23100630.html?#a20775082

Regards,

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20878725
The format of the Excel file required there is:
      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)

where you can see by the variable name which data should be in which column.

Regards,

Rob.
0
 

Author Comment

by:ZJY0021
ID: 20888705
thanks rob but like i said i am new so how do i get it to actually create the OU and add all the contacts into it.

sorry to be such a pain i went and got the full script but can not get it to work if you have some time could  you detail some of the functions more than they already are.

i can get it to open the excel read it close it but not do anything with the information in there.

thanks
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
LVL 65

Expert Comment

by:RobSampson
ID: 20889598
OK, no problem.  So, if you have it opening the file, then I take you've changed
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Contacts_Sharath.xls"

from this section:

' 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

which is great.  Now, the strContactOUPath describes the OU that must already exist to create the contacts object in.  This must also be specified in reverse OU order from the GUI. For example, this line:
   strContactOUPath = "OU=CS,OU=contacts,OU=User,OU=Countries," & objRootLDAP.Get("defaultNamingContext")

actually represents
   Domain.Com\Countries\User\contacts\CS

The Domain.Com is automatically populated by this:  & objRootLDAP.Get("defaultNamingContext")

Please note you MUST put the comma after the last OU (countries in the example above).

So after you make that change, we'll see what happens.Do you get any more messages in the DOS box that comes up?

Can you make sense of the columns that are required as above?
It's basically
Column A: First name
Column B: Last name
Column C: First name
Column D: Username - Please note the heading (D1) must have "Username (@domain.com)" as it's text,
                 where @domain.com should be your domain name as is listed in the User name combo box
                 under the account tab in Active Directory Users and Computers
Column E: Email address
Column F: Description
Column G: Office
Column H: Mobile
Column I: Title
Column J: Department
Column K: Company
Column L: Address
Column M: City
Column N: State
Column O: ZipCode
Column P: Country
Column Q: Homephone

And the only required fields are:
First Name
Last Name
Full Name
Email

and optional fields are:
Office
Description
Mobile
Title
Department
Company
Address
City
State
ZipCode
Country
HomePhone

Any other fields are not used for Contacts.

Hope that helps.

Regards,

Rob.
0
 

Author Comment

by:ZJY0021
ID: 20898054
Ok Rob first of all i really appriciate this that being said here is where i am at as i debug i get this

About to create:
joe
joe
bob
joe.bob@domain.com

LDAP://OU=test,OU=contacts,DC=imagenational,DC=com

but then it bombs at line 96



add-contacts-to-ad1.txt
excelscreenshot-for-code.bmp
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20898103
Try changing the heading in D1 to
username(@imagenational.com)

if you look at an existing contact in ADUC, go to the Account tab, have a look at the username. To the right should be a domain name.  That should be after your @ symbol in the heading in D1.

Also, can you post the contents of the DOS box that shows up?  That will have the error in it.

Do you have exchange?  If not, it won't be able to set the mailNickName or ProxyAddresses attributes, so comment those two lines out on lines 88 and 94.

Regards,

Rob.
0
 

Author Comment

by:ZJY0021
ID: 20901893
ok here is the structure our domain Imagenational.com the OU=Contacts inside of that is the OU i am trying to populate OU=Test

i have tried this
strContactOUPath = "OU=Contacts,OU=Test," & objRootLDAP.Get("defaultNamingContext")

and this way
strContactOUPath = "OU=Test,OU=Contacts," & objRootLDAP.Get("defaultNamingContext")

we have exchange 2003
Dosbox.bmp
0
 

Author Comment

by:ZJY0021
ID: 20902182
both of those OU's Contacts and test are there
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20916452
Hi, from that output, this is the right OUPath:
strContactOUPath = "OU=Test,OU=Contacts," & objRootLDAP.Get("defaultNamingContext")

but also, you're getting an error on Line 75, which is this line:
strContactOUPath = "OU=Test,OU=Contacts," & objRootLDAP.Get("defaultNamingContext")

Two lines above that, you must have
On Error Resume Next
not commented out.

It must be there.  It enables us to check if the contact already exists or not.

Regards,

Rob.
0
 

Author Comment

by:ZJY0021
ID: 20941830
thanks for sticking with me on this but it is still not working

here is the text from line 75 Set objNewContact = GetObject("LDAP://cn=" & strFullName & "," & strContactOUPath)

i have tried to run it with on error resume next commented out and with it commented but still it does not work dies on line 75
0
 

Author Comment

by:ZJY0021
ID: 20941925
Hey rob

is there anyway you could send me the code with everything filled out so i can see where i am going wrong.

i am wondering if it is here

Set objContact = objContactsContainer.Create("Contact","cn=" & strFullName)
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20942771
This should work.

Change strExcelFile to match the name of your file....

Regards,

Rob.
'====================
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, "") & "ContactsToCreate.xls"
strContactOUPath = "OU=Test,OU=Contacts," & 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
		
		' ********** CONTACT CREATION *************
		Set objContactsContainer = GetObject("LDAP://" & strContactOUPath)
		
		' Check if the contact already exists
		On Error Resume Next
		WScript.Echo "Checking if " & "LDAP://cn=" & strFullName & "," & strContactOUPath & " already exists...."
		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
			WScript.Echo "Creating " & "LDAP://cn=" & strFullName & "," & strContactOUPath
			' 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
'=========================

Open in new window

0
 

Author Comment

by:ZJY0021
ID: 20948865
i dont know what is wrong here i cant figure it out here is a where i recive errors

this is the line it stops on when i have Onerror commented out.

Set objNewContact = GetObject("LDAP://cn=" & strFullName & "," & strContactOUPath) - line 72

this is the line it stops on when i have Onerror NOT commented out.

objContact.SetInfo - Line 92

also attached are the diferent dos boxs with the errors when i run this either way.

is this script working for you?

thanks

excelscreenshot-for-code.bmp
Onerror-comminted-out.bmp
onerror-not-commeted-out.bmp
0
 

Author Comment

by:ZJY0021
ID: 20948916
Rob We do not use a Proxy dont know if that means anything
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20952323
Hmmm, please change this line on line 91:
objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & strAlias & "@" & Mid(Replace(objRootLDAP.Get("defaultNamingContext"), "DC=", "."), 2))

to just this:
objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail)

It's getting closer.  You'll probably notice in the Active Directory Users and Computers that the contact is actually now created, because it has got past the first SetInfo statement on line 89.  This means the contact should be created, it just doesn't have any of the attributes defined under this.

Also, please make sure you *always* leave in the On Error Resume Next uncommented, on line 70.  This verifies a check to see if the contact already exists, and error checking is turned back on by the On Error GoTo 0 statement a few lines later.

It's getting closer though....

Regards,

Rob.
0
 

Author Comment

by:ZJY0021
ID: 20952782
thanks rob i tried it no go also no contact is being created anywhere i did a search of ad nothing
error-after-code-change.bmp
0
 

Author Comment

by:ZJY0021
ID: 20952800
this is the line it bombs out on line 92

objContact.SetInfo

it does not know what to do at that point
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20952843
OK, comment out these five lines:
                  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)

and see if it gets further.....what is the domain functional level of your AD?  Right-click your domain name at the top of ADUC and click Properties.  On that first tab is your domain functional level.

Regards,

Rob.
0
 

Author Comment

by:ZJY0021
ID: 20952878
same error

functional level is 2003 also if i comment out line 92 objContact.SetInfo and line 107 objContact.SetInfo

it apears to work correctly attached is a screen shot but there is still no contact created in AD


line-92-and-107-commented-out.bmp
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20953099
Hmmm, I'm not sure why it said <user> already exists, and then said "creating <user>"....it should do one or the other.....try this.....I've commented out some other attributes, so we'll hopefully find which attribute is actually causing the problem....

Again, change your excel file path....

Regards,

Rob.
'====================
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, "") & "ContactsToCreate.xls"
strContactOUPath = "OU=Test,OU=Contacts," & 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
		
		' ********** CONTACT CREATION *************
		Set objContactsContainer = GetObject("LDAP://" & strContactOUPath)
		
		' Check if the contact already exists
		On Error Resume Next
		WScript.Echo "Checking if " & "LDAP://cn=" & strFullName & "," & strContactOUPath & " already exists...."
		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
			WScript.Echo "Creating " & "LDAP://cn=" & strFullName & "," & strContactOUPath
			' 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
'=========================

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20953131
Oh, and check your Contacts/Test OU, it looks like Billy Bob should have been created....
0
 

Author Comment

by:ZJY0021
ID: 20957604
even though it says billy bob is created it is not.

also now it just stops on line 107 objContact.SetInfo

i am at a loss i even bought a book still cant figure out whats wrong here (Sigh!) this should not be this hard
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20963546
Gee, that's weird.  This really should work.....

Hmmm, OK, make sure your Billy Bob contact does not exist in Contacts\Test, and then use this script to create it....we'll see if it works....

Just to ask....do you have Admin rights to be able to create these contacts?

Regards,

Rob.
' Set string variables
strContainer = "OU=Test,OU=Contacts"
strContactName = "cn=Billy Bob"
strMail = "Billy.Bob@imagenational.com"
strYourDescription = "New Contact"
 
' Section to attach to Active Directory
Set objRoot = GetObject("LDAP://rootDSE")
strDNS = objRoot.Get("defaultNamingContext") 
Set objDomain = GetObject("LDAP://" & strDNS) 
 
' Section to create the contact
Set objOU = GetObject("LDAP://"& strContainer & "," & strDNS)
Set objUser = objOU.Create("contact", strContactName)
objUser.Put "Description", strYourDescription
objUser.Put "Mail", strMail
objUser.SetInfo
 
Wscript.Echo "Look in " & strContainer & " for the new contact."

Open in new window

0
 

Author Comment

by:ZJY0021
ID: 20966214
yes i am the I.S. Manager here and i have the correct rights.

Also this created the contact finally something that worked.

0
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 20971989
Wow, strange, again try this code, and make sure your Excel file looks like the attached one.

Regards,

Rob.
'====================
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_Example.xls"
strContactOUPath = "OU=Test,OU=Contacts," & 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
		
		' ********** CONTACT CREATION *************
		Set objContactsContainer = GetObject("LDAP://" & strContactOUPath)
		
		' Check if the contact already exists
		On Error Resume Next
		WScript.Echo "Checking if " & "LDAP://cn=" & strFullName & "," & strContactOUPath & " already exists...."
		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
			WScript.Echo "Creating " & "LDAP://cn=" & strFullName & "," & strContactOUPath
			' 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
'=========================

Open in new window

Contacts-Example.xls
0
 

Author Comment

by:ZJY0021
ID: 20976301
it worked that time. here was the issue i did not have all the headings just
firstname lastname login and email,
once i populated all the headings it worked

I really appriciate you sicking with this for me.

thanks
0
 

Author Closing Comment

by:ZJY0021
ID: 31430175
Thank you very much
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 20979556
Ah, right, so yeah, it would have been trying to populate the wrong fields with the wrong values.

If you like, you should be able to go back to an earlier version that included updating some more of the attributes.....

Thanks for the grade.

Regards,

Rob.
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will inform Clients about common and important expectations from the freelancers (Experts) who are looking at your Gig.
Today, unlike web development, the mobile landscape is complex enough for a software engineer and Android is posing more challenging environment thanks to its fragmentation issues on hardware and software fronts.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Introduction to Processes

599 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question