Import Contacts into Active Directory including MailEnable

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

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

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?

check this link

https://www.experts-exchange.com/questions/22614431/vbscript-to-create-a-mail-enable-user-account-in-active-directory.html

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

Select allOpen in new window

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

Select allOpen in new window

very nice script, however, still doesnt mailenable the contact if it already exists. any other ideas? thanks for your efforts so far..

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.