Link to home
Start Free TrialLog in
Avatar of Brett Danney
Brett DanneyFlag for South Africa

asked on

Create Mail-Enabled contacts using VBScript and Excel

Hi all,

I'm trying to get a script to work that will create email-enabled contacts in Active Directory from an Excel file (external email addresses). The script below will create the contacts and they have an email address, but not the Exchange tabs and SMTP address.

I THINK you need to enter the "TargetAddress" and "ProxyAddress" parameters into the script, but I have no idea how or where.

The Contacts only need to contain the "Display Name" and email address fields. I don't require info like mobile number, first name, last name, etc.

Any and all help will be appreciated.
Option Explicit
Dim objRootLDAP, objContainer, objContact, objExcel, objSheet
Dim strOU, strContactName, strPathExcel, strEmail
Dim intRow, strYourDescription, strFirst, strLast
 
 
strPathExcel = "c:\Scripts\contact\contacts.xls"
strYourDescription = "Guy's Contact"
intRow = 3
 
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://OU=KAM Region,OU=dealer distribution contacts,OU=groups," & objRootLDAP.Get("DefaultNamingContext"))
 
Set objExcel = CreateObject("Excel.Application")
Set objSheet = objExcel.Workbooks.Open(strPathExcel)
 
Do Until (objExcel.Cells(intRow,1).Value) = ""
   strContactName = objExcel.Cells(intRow, 1).Value
   strEmail = objExcel.cells(intRow, 2).Value
   strFirst = objExcel.cells(intRow, 3).Value
   strLast = objExcel.cells(intRow, 4).Value
   Set objContact = objContainer.Create("Contact",_
   "cn=" & replace(strContactName,",","\,"))
   objContact.Put "Mail", strEmail
   objContact.Put "displayname",strcontactname
   objContact.SetInfo
intRow = intRow + 1
Loop
objExcel.Quit
 
WScript.Quit

Open in new window

Wrong.JPG
Right.JPG
Avatar of Chris Dent
Chris Dent
Flag of United Kingdom of Great Britain and Northern Ireland image


Install the Exchange Administrative Tools on the system running the script, then you can use "MailEnable" as below.

HTH

Chris
strYourDescription = "Guy's Contact"
intRow = 3
 
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://OU=KAM Region,OU=dealer distribution contacts,OU=groups," & objRootLDAP.Get("DefaultNamingContext"))
 
Set objExcel = CreateObject("Excel.Application")
Set objSheet = objExcel.Workbooks.Open(strPathExcel)
 
Do Until (objExcel.Cells(intRow,1).Value) = ""
   strContactName = objExcel.Cells(intRow, 1).Value
   strEmail = objExcel.cells(intRow, 2).Value
   strFirst = objExcel.cells(intRow, 3).Value
   strLast = objExcel.cells(intRow, 4).Value
   Set objContact = objContainer.Create("Contact",_
   "cn=" & replace(strContactName,",","\,"))
   objContact.Put "displayname",strcontactname
   objContact.SetInfo
 
   ' Mail Enable the contact using Exchange tools
   objContact.MailEnable strEmail
 
intRow = intRow + 1
Loop
objExcel.Quit
 
WScript.Quit

Open in new window

Avatar of Brett Danney

ASKER

I have 3500 contacts to create though :( There must be a way to do it via the script.

That is via the script :)

It's just you need a DLL from the system tools to be able to use the "MailEnable" method above (objContact.MailEnable <address>) which adds all of the Exchange attributes including Target Address.

Sorry for the confusion :)

Chris

Just to be clear, I really don't mean you should load up the exchange console and do it manually.

It's just the CDOEXM.dll file we need on properly registered on the system which you get as part of the system tools. That opens up a pile of Exchange commands which can be used through the script above. MailEnable is one of those :)

Chris
I've attached the error I get. I've also included all my code.

Thanks :)
Option Explicit
Dim objRootLDAP, objContainer, objContact, objExcel, objSheet
Dim strOU, strContactName, strPathExcel, strEmail
Dim intRow, strYourDescription, strFirst, strLast
 
 
strPathExcel = "c:\Scripts\contact\contacts.xls"
strYourDescription = "Guy's Contact"
intRow = 3
 
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://OU=KAM Region,OU=dealer distribution contacts,OU=groups," & objRootLDAP.Get("DefaultNamingContext"))
 
Set objExcel = CreateObject("Excel.Application")
Set objSheet = objExcel.Workbooks.Open(strPathExcel)
 
Do Until (objExcel.Cells(intRow,1).Value) = ""
   strContactName = objExcel.Cells(intRow, 1).Value
   strEmail = objExcel.cells(intRow, 2).Value
   strFirst = objExcel.cells(intRow, 3).Value
   strLast = objExcel.cells(intRow, 4).Value
   Set objContact = objContainer.Create("Contact",_
   "cn=" & replace(strContactName,",","\,"))
   objContact.Put "Mail", strEmail
   objContact.Put "displayname",strcontactname
   objContact.mailenable strEmail
   objContact.SetInfo
intRow = intRow + 1
Loop
objExcel.Quit
 
WScript.Quit

Open in new window

untitled.JPG

You've installed the Exchange System Tools now? :)

And your SetInfo will need to go before MailEnable, not after it. MailEnable itself doesn't need a SetInfo. As in the example below.

Chris
Option Explicit
Dim objRootLDAP, objContainer, objContact, objExcel, objSheet
Dim strOU, strContactName, strPathExcel, strEmail
Dim intRow, strYourDescription, strFirst, strLast
 
 
strPathExcel = "c:\Scripts\contact\contacts.xls"
strYourDescription = "Guy's Contact"
intRow = 3
 
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://OU=KAM Region,OU=dealer distribution contacts,OU=groups," & objRootLDAP.Get("DefaultNamingContext"))
 
Set objExcel = CreateObject("Excel.Application")
Set objSheet = objExcel.Workbooks.Open(strPathExcel)
 
Do Until (objExcel.Cells(intRow,1).Value) = ""
   strContactName = objExcel.Cells(intRow, 1).Value
   strEmail = objExcel.cells(intRow, 2).Value
   strFirst = objExcel.cells(intRow, 3).Value
   strLast = objExcel.cells(intRow, 4).Value
   Set objContact = objContainer.Create("Contact",_
   "cn=" & replace(strContactName,",","\,"))
   objContact.Put "Mail", strEmail
   objContact.Put "displayname",strcontactname
   objContact.SetInfo
   objContact.mailenable strEmail
intRow = intRow + 1
Loop
objExcel.Quit
 
WScript.Quit

Open in new window

Yeah Exchange System Tools are installed :) CDOEXM.DLL is in c:\program files\exchsvr\bin

I get the same error mate. Line 27, Character 4..... "Object doesn't support this property or method: 'mailenable'

Well that's annoying. Typically my Exchange 2003 test environment is off-line at the moment so I can't see if I can reproduce it.

We could always try dropping the current connection to the contact then recreating it. If only because occasionally you can get odd behaviour from the "Created" version of the contact.

So...

Set objContact = Nothing
Set objContact = GetObject("LDAP://CN=" & Replace(strContactName, ",", "\,") & _
  "," & objContainer.Get("distinguishedName"))
objContact.MailEnable strEmail

Which really shouldn't make the slightest bit of difference, but is worth a try.

Chris
I hope I edited the script correctly, but I still get the same error :(

Line 31, Char 4....""Object doesn't support this property or method: 'MailEnable'

I'm half-tempted to install MS Office on my Exchange server and try on there. Although the boss would probably lynch me!
Option Explicit
Dim objRootLDAP, objContainer, objContact, objExcel, objSheet
Dim strOU, strContactName, strPathExcel, strEmail
Dim intRow, strYourDescription, strFirst, strLast
 
 
strPathExcel = "c:\Scripts\contact\contacts.xls"
strYourDescription = "Guy's Contact"
intRow = 3
 
 
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://OU=KAM Region,OU=dealer distribution contacts,OU=groups," & objRootLDAP.Get("DefaultNamingContext"))
 
Set objExcel = CreateObject("Excel.Application")
Set objSheet = objExcel.Workbooks.Open(strPathExcel)
 
Do Until (objExcel.Cells(intRow,1).Value) = ""
   strContactName = objExcel.Cells(intRow, 1).Value
   strEmail = objExcel.cells(intRow, 2).Value
   strFirst = objExcel.cells(intRow, 3).Value
   strLast = objExcel.cells(intRow, 4).Value
   Set objContact = objContainer.Create("Contact",_
   "cn=" & replace(strContactName,",","\,"))
   objContact.Put "Mail", strEmail
   objContact.Put "displayname",strcontactname
   objContact.SetInfo
   Set objContact = Nothing
   Set objContact = GetObject("LDAP://CN=" & Replace(strContactName, ",", "\,") & _
  "," & objContainer.Get("distinguishedName"))
   objContact.MailEnable strEmail
intRow = intRow + 1
Loop
objExcel.Quit
 
WScript.Quit

Open in new window


Yeah, don't do that, it messes with MAPI, something you really don't want on the Exchange Server :)

Try installing the system tools on a workstation perhaps? Persisting because I know this method works having used it extensively in the past :)

Chris
I installed the Exchange Administrative Tools on my Windows 2003 Standard workstation and the script runes without errors, but the contacts still look like the "wrong.jpg" image I pasted in my original question. ie. not mail-enabled :(

Hmm you ran the version of AD Users and Computers from the Exchange folder (rather than Administrative Tools)? It's just if it ran MailEnable without crying it should have done the job. Perhaps clutching at straws there ;)

Chris
I'd love to say it makes a difference... but it doesn't!
untitled.JPG
If I try to Establish an email address on this contact, it bring up the following screen. As far as I know, it SHOULD say "SMTP:" before the email address which it doesnt.
untitled.JPG

Yeah, it should for that one.

Perhaps don't write an entry to "mail". It'll populate is the silly thing manages to execute "MailEnable" properly.

Chris
I commented out the line "objContact.Put "Mail", strEmail" and it didn't do much except leave all the email fields blank :P

Am I not perhaps missing the "TargetAddress" and "ProxyAddress" parameters? I read somewhere that those are important.

They are, but that's part of what MailEnable does. It populates everything Exchange needs, setting the e-mail address we pass in "strEmail" as the TargetAddress. That then ends up as the Primary on the proxyAddresses and ends up in the mail field.

How about Service Packs for the Exchange System Tools? I've only ever used this with Exchange 2003 SP2, but I'd be really surprised if it wasn't in the base install as well.

Chris
Hi Chris

I just installed Exchange SP2 on the Win2003 server I'm testing this on and it didn't help.

I don't suppose your test Exchange environment is back up and running? :)

Nope, but I think I've done what I was doing on it, I'll restore it and make it work again.

Chris
ASKER CERTIFIED SOLUTION
Avatar of Chris Dent
Chris Dent
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
It works perfectly now! Thanks so much.

There's only one other thing that I could use your help with. Can we set the parameter "hide from exchange mailing lists"? I don't want 3500+ contacts filling up my GAL :)

Sure :)

Add:

objContact.Put "msExchHideFromAddressLists", True
objContact.SetInfo

Chris
Absolutely perfect :) Thanks again!
A really patient and helpful guy. A real credit to EE!

No problem, glad we got there in the end :)

Chris
Chris,

I've already got the script from the other thread working, it imports users fine. you still can't email them though. No need to rewrite it.

Matt
How can I add more email addresses to the script and make one of them primary?