Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Adding Contacts to AD

Status
Not open for further replies.

Mighty

Programmer
Feb 22, 2001
1,682
US
I am using VBScript to pull contact information from a CRM database and use this information to create contacts in a specific OU in Active Directory. These contacts then populate a custom address list in Exchange.

That's the background. The problem I am hitting now is one of multiple contacts with the same name. How do I get around this. What fields in AD contacts must be unique. I need to be able to add all contacts even if there are names the same

Mighty
 
I believe this needs to be unique

Code:
 Set objContact = objOU.Create("Contact", strContactName)

I am assuming your script uses something similar to that. What you could do is create another OU and do a check

if contact exist than
go to diff ou
else
create contact
end if

you probably get my drift on my sudo code.
 
w33mhz - does the legacyExchangeDN also need to be unique?

Pat - As per your request, here is the main body of the code - doesn't include the sql command to populate the recordset(rs)

Code:
' Section to bind to Active Directory
Set objContainer=GetObject("LDAP://OU=OnStream,DC=MyCompany,DC=local")

' Delete all the current contacts from the OnStream OU
for each objContact in objContainer
	objContainer.delete "contact", "cn=" & objContact.CN
next

' Loop through the list of contacts
do while not rs.EOF

	' Set string variables
	strMainDefault = "SMTP:" & rs("Email")
	strContactName = rs("name")
	strFirst = rs("firstname")
	strLast= rs("surname")
	strDisplay = rs("compName") & " - " & rs("name")
	strTitle = "" & rs("title")
	strEmail = rs("Email")
	strNickName = Replace(rs("name"), " ", "")
	strMailbox = "/o=My Company/ou=MY_COMPANY/cn=Recipients/cn=" & strNickName


	' Build the contact and store in AD
	Set objContact = objContainer.Create("Contact","cn=" & strContactName)
	objContact.Put "givenName", strFirst
	objContact.Put "sn", strLast
	if strTitle <> "" then objContact.Put "title", strTitle
	objContact.Put "description", "OnStream"
	objContact.Put "displayName", strDisplay
	objContact.Put "company", "" & rs("compName")
	objContact.Put "Mail", strEmail
	objContact.Put "targetAddress", strMainDefault
	objContact.Put "legacyExchangeDN", strMailbox
	objContact.Put "mailNickname", strNickName
	objContact.SetInfo 

	' Close the conact object
	Set objContact = Nothing
	
	' Move to the next contact
	rs.MoveNext

loop

' Close the LDAP Container Object
Set objContainer = Nothing

Mighty
 
You could also add a digit or something to the contact, or any kind of change you want like the business name at the end from a check that you put in.
i.e.

John Smith to
John Smith Business1

I would just create a function and throw it in there right before you create the contact.
 
Try this :
Code:
' Section to bind to Active Directory
Set objContainer=GetObject("LDAP://OU=OnStream,DC=MyCompany,DC=local")

' Delete all the current contacts from the OnStream OU
for each objContact in objContainer
    objContainer.delete "contact", "cn=" & objContact.CN
next

' Loop through the list of contacts
do while not rs.EOF

    ' Set string variables
    strMainDefault = "SMTP:" & rs("Email")
    strContactName = rs("name")
    strFirst = rs("firstname")
    strLast= rs("surname")
    strDisplay = rs("compName") & " - " & rs("name")
    strTitle = "" & rs("title")
    strEmail = rs("Email")
    strNickName = Replace(rs("name"), " ", "")
    strMailbox = "/o=My Company/ou=MY_COMPANY/cn=Recipients/cn=" & strNickName

    ChecContact(strContactName)

    ' Build the contact and store in AD
    Set objContact = objContainer.Create("Contact","cn=" & strContactName)
    objContact.Put "givenName", strFirst
    objContact.Put "sn", strLast
    if strTitle <> "" then objContact.Put "title", strTitle
    objContact.Put "description", "OnStream"
    objContact.Put "displayName", strDisplay
    objContact.Put "company", "" & rs("compName")
    objContact.Put "Mail", strEmail
    objContact.Put "targetAddress", strMainDefault
    objContact.Put "legacyExchangeDN", strMailbox
    objContact.Put "mailNickname", strNickName
    objContact.SetInfo 

    ' Close the conact object
    Set objContact = Nothing
    
    ' Move to the next contact
    rs.MoveNext

loop

' Close the LDAP Container Object
Set objContainer = Nothing


Function CheckContact(name)
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

objCommand.CommandText = _
 "<LDAP://OU=OnStream,DC=MyCompany,DC=local>;;name;onelevel"
Set objRecordSet = objCommand.Execute

While Not objRecordset.EOF
	If objRecordset.Fields("name") = strContactName Than
		strContactName = strContactName & rs("CompName")
		objRecordset.MoveNext
	Else 
		objRecordset.MoveNext
	End If
Wend

objConnection.Close

End Function
 
Pat,

As your code helped me out the last time I am hoping that you can help me again. My problem now is that I am getting multiple contacts added with the same email address. I am trying to modify the LDAP query to just search for contacts with a specific email address. I have tried the following but none of them seem to return any records even though I know that matching records exist:

Code:
cmd.CommandText = "<LDAP://OU=myOU,DC=myCompany,DC=local>;(mail='" & emailAddr & "');name;onelevel"
cmd.CommandText = "<LDAP://OU=myOU,DC=myCompany,DC=local>;(email='" & emailAddr & "');name;onelevel"
cmd.CommandText = "<LDAP://OU=myOU,DC=myCompany,DC=local>;(targetAddress='SMTP:" & emailAddr & "');name;onelevel"

Any suggestions?

Mighty
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top