Solved

Import Contacts into Active Directory including MailEnable

Posted on 2008-06-18
9
1,457 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Free NetCrunch network monitor licenses!

Only on Experts-Exchange: Sign-up for a free-trial and we'll send you your permanent license!

Here is what you get: 30 Nodes | Unlimited Sensors | No Time Restrictions | Absolutely FREE!

Act now. This offer ends July 14, 2017.

 
LVL 9

Expert Comment

by:JonMny
ID: 21866000
0
 

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

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

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

Uncontrolled local administrators groups within any organization pose a huge security risk. Because these groups are locally managed it becomes difficult to audit and maintain them.
Unified and professional email signatures help maintain a consistent company brand image to the outside world. This article shows how to create an email signature in Exchange Server 2010 using a transport rule and how to overcome native limitations …
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 …
This video demonstrates how to sync Microsoft Exchange Public Folders with smartphones using CodeTwo Exchange Sync and Exchange ActiveSync. To learn more about CodeTwo Exchange Sync and download the free trial, go to: http://www.codetwo.com/excha…

717 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