Adding Contacts to AD

[Mighty]

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

 

[w33mhz]

I believe this needs to be unique

 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.

 

[58sniper]

And by all means - share the script!

Pat Richard, MCSE MCSA:Messaging CNA
Microsoft Exchange MVP
Want to know how email works? Read for yourself -

http://www.ietf.org/rfc/rfc2821.txt

 

[Mighty]

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)

' 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

 

[w33mhz]

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.

 

[w33mhz]

Try this :

' 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

 

[Mighty]

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:

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