Solved

Import Contacts into Active Directory including MailEnable

Posted on 2008-06-18
9
1,449 Views
Last Modified: 2008-07-03
Hi,
I need to import 700+ contacts into active directory. I had a previous question raised to do this however after importing them I noticed that they are not mail enabled and therefor not showing up in GAL. I was wondering what I need to do to add the mailenable option and set it with the contacts email address. I have included the code so far.
Thanks
' Purpose VBScript to create contacts from a list on names in Excel

' ----------------------------------------------------------------- 
 

Option Explicit

On Error Resume Next

Dim objRootLDAP, objContainer, objContact, objExcel, objSheet

Dim strOU, strContactName, strPathExcel, strEmail

Dim intRow, strYourDescription, strFirst, strLast

Dim strOfficeNo, strMobileNo, strTitle, strOffice

Dim strDepartment, strCompany, strMail

 

' Set string variables

' Note: Assume an OU called Connaught Contacts exists.

strOU = "OU=Connaught Contacts ," ' Note the comma

strPathExcel = "C:\Contacts.xls"

strYourDescription = "Company Contacts"

intRow = 3 ' 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

   strEmail = objExcel.cells(intRow, 2).Value

   'mail enable

   'strMail = objExcel.cells(intRow, 2).Value

   strFirst = objExcel.cells(intRow, 3).Value

   strLast = objExcel.cells(intRow, 4).Value

   strOfficeNo = objExcel.cells(intRow, 5).Value

   strMobileNo = objExcel.cells(intRow, 6).Value

   strTitle = objExcel.cells(intRow, 7).Value

   strOffice = objExcel.cells(intRow, 8).Value

   strDepartment = objExcel.cells(intRow, 9).Value

   strCompany = objExcel.cells(intRow, 10).Value

   

   ' Build the actual contacts.

   Set objContact = objContainer.Create("Contact","cn=" _ 

   & Replace(strContactName,",","\,"))

   if strEmail <> "" then objContact.Put "Mail", strEmail

   if strFirst <> "" then objContact.Put "givenName", strFirst

   if strLast <> "" then objContact.Put "sn", strLast

   if strOfficeNo <> "" then objContact.Put "telephoneNumber", strOfficeNo

   if strMobileNo <> "" then objContact.Put "mobile", strMobileNo

   if strTitle <> "" then objContact.Put "title", strTitle

   if strOffice <> "" then objContact.Put "physicalDeliveryOfficeName", strOffice

   if strDepartment <> "" then objContact.Put "department", strDepartment

   if strCompany <> "" then objContact.Put "company", strCompany

   ' Mail Enable

   

   ' End Mail Enable

   objContact.SetInfo 

intRow = intRow + 1

Loop

objExcel.Quit 

 

WScript.Quit 

 

' End of Sample ContactExcel VBScript

Open in new window

0
Comment
Question by:cullyk
  • 4
  • 3
  • 2
9 Comments
 
LVL 9

Expert Comment

by:JonMny
ID: 21814036
try somthing like this


strUser = "LDAP://cn=no mail2,cn=users,dc=demo,dc=local"

Set oUser = GetObject(strUser)

oUser.put "mail", "myMail@mail.com"
oUser.put "mailnickname", "nick name hger"
oUser.put "DisplayName", "namehere"
ouser.put "proxyAddresses", Array("SMTP:myMail@mail.com","smtp:smyMail@Mail.com")
ouser.put "targetAddress", "SMTP:myMail@mail.com"

oUser.SetInfo
Set oUser = Nothing
0
 
LVL 19

Expert Comment

by:weellio
ID: 21815439
try this

objContact.mailenable strEmail

or this if that doesn't work

objuser = GetObject(LDAP://" & strOU _
& objRootLDAP.Get("DefaultNamingContext") & ","cn=" _
   & Replace(strContactName,",","\,"))

objuser.mailenable StrEmail
0
 

Author Comment

by:cullyk
ID: 21863566
Thanks for your comments, I have tried playing around with this with no luck. I am not sure I'm implementing it correctly into my existing script but i dont get any results even if I delete the contact and allow the script to re-create it. Any ideas?
0
 
LVL 9

Expert Comment

by:JonMny
ID: 21866000
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:cullyk
ID: 21867331
ok, ive changed it to this, which works fine for new contacts but doesnt amend the contacts already created. I could just have another script to go though the list and delete all the contacts and then just run the origianl amended script but id rather have this one be able to make an existing contact mail enabled. any idea?
' Purpose VBScript to create contacts from a list on names in Excel

' ----------------------------------------------------------------- 
 

Option Explicit

On Error Resume Next

Dim objRootLDAP, objContainer, objContact, objExcel, objSheet

Dim strOU, strContactName, strPathExcel, strEmail

Dim intRow, strYourDescription, strFirst, strLast

Dim strOfficeNo, strMobileNo, strTitle, strOffice'

Dim strDepartment, strCompany, strMail

 

' Set string variables

' Note: Assume an OU called Contacts exists.

strOU = "OU=Contacts ," ' Note the comma

strPathExcel = "C:\Contacts.xls"

strYourDescription = "Company Contacts"

intRow = 3 ' 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

   strEmail = objExcel.cells(intRow, 2).Value

   'mail enable

   strMail = objExcel.cells(intRow, 2).Value

   strFirst = objExcel.cells(intRow, 3).Value

   strLast = objExcel.cells(intRow, 4).Value

   strOfficeNo = objExcel.cells(intRow, 5).Value

   strMobileNo = objExcel.cells(intRow, 6).Value

   strTitle = objExcel.cells(intRow, 7).Value

   strOffice = objExcel.cells(intRow, 8).Value

   strDepartment = objExcel.cells(intRow, 9).Value

   strCompany = objExcel.cells(intRow, 10).Value

   

   ' Build the actual contacts.

   Set objContact = objContainer.Create("Contact","cn=" _ 

   & Replace(strContactName,",","\,"))

   if strEmail <> "" then objContact.Put "Mail", strEmail

   if strFirst <> "" then objContact.Put "givenName", strFirst

   if strLast <> "" then objContact.Put "sn", strLast

   if strOfficeNo <> "" then objContact.Put "telephoneNumber", strOfficeNo

   if strMobileNo <> "" then objContact.Put "mobile", strMobileNo

   if strTitle <> "" then objContact.Put "title", strTitle

   if strOffice <> "" then objContact.Put "physicalDeliveryOfficeName", strOffice

   if strDepartment <> "" then objContact.Put "department", strDepartment

   if strCompany <> "" Then objContact.Put "company", strCompany

   If strMail <> "" Then objContact.Put "displayNamePrintable", strMail

   ' Mail Enable

	objContact.MailEnable strEmail

   ' End Mail Enable

   objContact.SetInfo 

intRow = intRow + 1

Loop

objExcel.Quit 

MsgBox "Completed" 

WScript.Quit

' End of Sample ContactExcel VBScript

Open in new window

0
 
LVL 19

Expert Comment

by:weellio
ID: 21880876
i don't have exchange here so i can't test fully, but let me know if this works for you i added debugging help
' Purpose VBScript to create contacts from a list on names in Excel

' ----------------------------------------------------------------- 

 

Option Explicit

On Error Resume Next
 

Const black = "black"

Const blue = "blue"

Const green = "green"

Const red = "red"
 

Dim objRootLDAP, objContainer, objContact, objExcel, objSheet

Dim strOU, strContactName, strPathExcel, strEmail

Dim intRow, strYourDescription, strFirst, strLast

Dim strOfficeNo, strMobileNo, strTitle, strOffice'

Dim strDepartment, strCompany, strMail, setdebug
 

' turn off to disable debugging

setdebug = "on"
 

trace "Start", black

 

' Set string variables

' Note: Assume an OU called Contacts exists.

strOU = "OU=Contacts ," ' Note the comma

strPathExcel = "C:\Contacts.xls"
 

strYourDescription = "Company Contacts"

intRow = 3 ' Row 1 contains headings

 

' Section to bind to Active Directory

Set objRootLDAP = GetObject("LDAP://rootDSE")

Set objContainer = GetObject("LDAP://" & strOU _

& objRootLDAP.Get("DefaultNamingContext")) 
 

'verify connectino works

If Err.number <> 0 Then

	errlog("Problem binding with AD")

Else

	trace "Binding to Active Directory Successful", blue

end if
 

 

' Open the Excel spreadsheet

Set objExcel = CreateObject("Excel.Application")
 

If Err.number <> 0 Then

	errlog("Problem opening Excel")

Else

	trace "Excel opened", blue

end if

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

	strEmail = objExcel.cells(intRow, 2).Value

	'mail enable

	strMail = objExcel.cells(intRow, 2).Value

	strFirst = objExcel.cells(intRow, 3).Value

	strLast = objExcel.cells(intRow, 4).Value

	strOfficeNo = objExcel.cells(intRow, 5).Value

	strMobileNo = objExcel.cells(intRow, 6).Value

	strTitle = objExcel.cells(intRow, 7).Value

	strOffice = objExcel.cells(intRow, 8).Value

	strDepartment = objExcel.cells(intRow, 9).Value

	strCompany = objExcel.cells(intRow, 10).Value

	

	'output to debug

	trace "User information :", black

	trace "strContactName = " & objExcel.Cells(intRow, 1).Value, green

	trace "strEmail = " &  objExcel.cells(intRow, 2).Value, green

	trace "strMail = " &  objExcel.cells(intRow, 2).Value, green

	trace "strFirst = " &  objExcel.cells(intRow, 3).Value, green

	trace "strLast = " &  objExcel.cells(intRow, 4).Value, green

	trace "strOfficeNo = " &  objExcel.cells(intRow, 5).Value, green

	trace "strMobileNo = " &  objExcel.cells(intRow, 6).Value, green

	trace "strTitle = " &  objExcel.cells(intRow, 7).Value, green

	trace "strOffice = " &  objExcel.cells(intRow, 8).Value, green

	trace "strDepartment = " &  objExcel.cells(intRow, 9).Value, green

	trace "strCompany = " &  objExcel.cells(intRow, 10).Value, green
 

	'Check to see if the account already exists

	if does_SAM_exist(strContactName) = False then	 'false = 0
 

		' Build the actual contacts.

		Set objContact = objContainer.Create("Contact","cn=" _ 

		& Replace(strContactName,",","\,"))

		if strEmail <> "" then objContact.Put "Mail", strEmail

		if strFirst <> "" then objContact.Put "givenName", strFirst

		if strLast <> "" then objContact.Put "sn", strLast

		if strOfficeNo <> "" then objContact.Put "telephoneNumber", strOfficeNo

		if strMobileNo <> "" then objContact.Put "mobile", strMobileNo

		if strTitle <> "" then objContact.Put "title", strTitle

		if strOffice <> "" then objContact.Put "physicalDeliveryOfficeName", strOffice

		if strDepartment <> "" then objContact.Put "department", strDepartment

		if strCompany <> "" Then objContact.Put "company", strCompany

		If strMail <> "" Then objContact.Put "displayNamePrintable", strMail

		' Mail Enable

		objContact.MailEnable strEmail

		' End Mail Enable

		objContact.SetInfo 

	'if the account exists

	else

		'verify that the mail is enabled

		if mailenabled(strContactName) = false then

		end if

	end if

intRow = intRow + 1

Loop

objExcel.Quit 

MsgBox "Completed" 

WScript.Quit

' End of Sample ContactExcel VBScript
 

'**************************************************************

'***************** User Exists function ***********************

'**************************************************************
 

function does_SAM_exist(sam)

trace "Checking if user exists", blue

	Dim objConnection, objCommand

	Dim strFilter, strQuery, objRecordSet, objArgs, usr

	Set objConnection = CreateObject("ADODB.Connection") 

	Set objCommand = CreateObject("ADODB.Command") 

	objConnection.Provider = "ADsDSOOBject"

	objConnection.Open "Active Directory Provider"

	Set objCommand.ActiveConnection = objConnection

	strBase = "<LDAP://" & objContainer & ">" 

	strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & sam & "))" 

	strAttributes = "homeMDB, distinguishedName,sAMAccountName"

	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

	objCommand.CommandText = strQuery
 

	If Err.number <> 0 Then

		errlog("Problem Running Command : " & strquery)

	Else

		trace "Successfully opened : " & strquery, blue

	end if

	objCommand.Properties("Page Size") = 99999

	objCommand.Properties("Timeout") = 300

	objCommand.Properties("Cache Results") = False

	Set objRecordSet = objCommand.Execute

	If Err.number <> 0 Then

		errlog("Problem opening recordset")

	Else

		trace "Successfully opened recordset", blue

	end if	

	objRecordSet.MoveFirst

	Do Until objRecordSet.EOF

		strDN = objRecordSet.Fields("distinguishedName") 

		strSAM = objRecordSet.Fields("sAMAccountName")

		homeMDB = objRecordSet.Fields("homeMDB")

		usr = "Y"

		trace strSAM & " already exists", blue

		trace "DN = " & """" & strDN & """" , green

		if homeMDB <> "" then trace "mailenabled = " & homeMDB

		objRecordSet.MoveNext

	Loop

	objConnection.Close

	Set objConnection = Nothing

	

	if usr = "Y" Then 

		'1 = user does exist & mail is not enabled

		does_SAM_exist = 1

		if homeMDB <> "" then 

			'2 = user does exist & mail is enabled

			does_SAM_exist = 2

			trace "user does exist & mail is enabled", green

		else

			Set objUser = GetObject("LDAP://" & strDN)

				objUser.MailEnable strEmail

				objUser.Put "internetEncoding",1310720

				objUser.SetInfo()

			Set objUser = nothing
 

			If Err.number <> 0 Then

			errlog("Problem setting mailenabled for user strSAM")

			Else

			trace "Successfully enabled mail for " & strSAM , blue

			end if	

		end if

	else

		'0 = user doesn't exist

		does_SAM_exist = 0

		trace "user does exist & mail is enabled", green

	end if

	

	

	Set objCommand = Nothing

	Set objRecordSet = Nothing

end function
 
 

'**************************************************************

'******************** Trace Function **************************

'**************************************************************

Dim oIE

Sub Trace(sMsg, color)

	'using IE to record what is happening

	if setdebug = "on" then

		If Not IsObject(oIE) Then

			Set oIE = CreateObject("InternetExplorer.Application")

			oIE.navigate "about:blank"

			oIE.ToolBar = False

			oIE.AddressBar = False

			oIE.Top = 10

			oIE.left = 10

			oIE.Width = 1000

			oIE.Height = 500

			oIE.Visible = True

			oIE.menubar = False

			oIE.StatusBar = False

			oIE.Document.Body.Title = "Debug Messages"

		End If

		Select case color

		case black

			oIE.Document.writeln Date & "<font size=2 color=" & color & "> - " & smsg & "</font><BR>"

		case blue

			oIE.Document.writeln Date & "<font size=3 color=" & color & "> - " & smsg & "</font><BR>"

		case red

			oIE.Document.writeln Date & "<font size=5 color=" & color & "> - " & smsg & "</font><BR>"

		case green

			oIE.Document.writeln Date & "<font size=4 color=" & color & "> - " & smsg & "</font><BR>"

		case else

			oIE.Document.writeln Date & "<font size=1 color=" & color & "> - " & smsg & "</font><BR>"

		end select

		else

	end if

End Sub

 

'**************************************************************

'******************** error trapping  *************************

'**************************************************************

 

sub errlog(errmsg)

	'error trapping

	if setdebug = "on" then

	'turn errors red

		  trace errmsg, "red"

		  trace Err.Description & " : " & Err.Number, "red"

	'Clear error

		  Err.Clear   

		  else

	end if

end Sub

Open in new window

0
 

Author Comment

by:cullyk
ID: 21914848
very nice script, however, still doesnt mailenable the contact if it already exists. any other ideas? thanks for your efforts so far..
0
 
LVL 19

Accepted Solution

by:
weellio earned 250 total points
ID: 21921802
well dangit,..... hmmmmmmm
it is supposed to,..


maybe it needs to have the email specified before the mailenable

add

objuser.Put "Mail", strEmail

after line 172


basically replace

                  Set objUser = GetObject("LDAP://" & strDN)
                        objUser.MailEnable strEmail
                        objUser.Put "internetEncoding",1310720
                        objUser.SetInfo()
                  Set objUser = nothing

with

                  Set objUser = GetObject("LDAP://" & strDN)
                        objuser.Put "Mail", strEmail   ' <----------
                        objUser.MailEnable strEmail
                        objUser.Put "internetEncoding",1310720
                        objUser.SetInfo()
                  Set objUser = nothing
0
 

Author Comment

by:cullyk
ID: 21926740
I ended up moving all the contacts to a new OU. Then running the script so it created the contacts correctly. Then telling AD to move all the contacts back. It moved the ones that hadn't been re created and errored on the rest. I then deleted the duplicates. Thanks for your efforts though. Points to weellio.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Synchronize a new Active Directory domain with an existing Office 365 tenant
This article explains in simple steps how to renew expiring Exchange Server Internal Transport Certificate.
In this video we show how to create an Address List in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Organization >> Ad…
This tutorial will walk an individual through the process of configuring their Windows Server 2012 domain controller to synchronize its time with a trusted, external resource. Use Google, Bing, or other preferred search engine to locate trusted NTP …

758 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now