کد:
http://www.msexchange.org/articles/Migrating-Contacts-Distribution-Lists-Outlook-Active-Directory.html
Amit Zinman
Introduction
In my article "
Using Exchange 2000 as a low end contact management solution" I presented a way of using Active Directory to search for contacts. Active Directory, once it is extended by Exchange, provides a scalable solution for looking up contacts using the LDAP protocol. Resolving contact names using Outlook when accessing Active Directory is really fast, even if you have hundreds of contacts, and doesn't slow down the way it does when you have too many contacts in an Outlook contacts public folder.
On the other hand Outlook contacts folders are really easy to use. You can import information from a lot of sources using the Import and Export wizard without much hassle. Any application which supports exports of its contacts to a text file can be exported to Outlook because you can always rearrange the contact field to match those of Outlook.
While Active Directory provides the LDIFDE and CSVDE utilities for importing bulk information, they are not really the easiest conversion utilities that one could hope for.
I will present here some useful scripts for migrating contacts from Outlook to Active Directory. For you, it can be a two part process. For example, if you need to migrate 70,000 contacts from Outlook Express, you can first export them to Outlook, and then use my scripts to transport them to Active Directory.
Contact Migration Script
My script, written in VBScript language has the following requirements. It assumes you've placed the contacts in a Public Folder named "Company Contacts", but you can change the line that begins with "Set myfolder = myNameSpace.Folders" to point to whichever Outlook folder suits you.
You will need to change the line that begins with "Set objContainer =" so that it will point to an existing Organization Unit (OU) where the Contacts will be placed. To do this, replace the part that says "OU=….,DC=…." with the distinguishedName attribute of the OU. This property can be found by using the support tools utility ADSIEdit.
For the script to work properly you would also require the "countrycodes.csv" file downloaded
here. This file allows Active Directory to register a contact's country with its country code.
The script goes through all the contacts in the Public Folder, checks to see whether the contact already exists and if not creates the contact. It goes through all the contact fields and if a contact property exists it is translated to its Active Directory equivalent.
A couple of issues came up while writing this script. The main one was what to do with duplicate contacts, or contacts with same name. The primary check is to see whether the e-mail address exists. If it does not and the contact name already exist (as determined by the DNExists function), the company name is added to the directory name of the new contact.
The script migrates only the business address. You can customize the script to add the home address but know that the Active Directory Users and Computers snap-in does not show this address at this point.
کد:
'ContactMigationScript.vbs
Dim objRecip
'On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set myOlApp = CreateObject ("Outlook.Application")
Set myNameSpace = myOlApp.Application.GetNamespace("MAPI")
'Get the Public Folder containing the contacts
Set myfolder = myNameSpace.Folders("Public Folders"). _
Folders("All Public folders").Folders("Public Contacts")
'Open a test file for reporting putposes
Set reportfile = fs.CreateTextFile ("c:\contactreport.txt")
'Look for all contacts in the Public Folder
For I = 1 To myfolder.Items.Count
If TypeName(myfolder.Items.Item(I)) = "ContactItem" Then
Set outlookcontact = myfolder.Items(I)
'Fix the FileAs field so it won't contain Linefeeds.
FixedFileAs = Replace (outlookcontact.FileAs,Chr(13)," - ")
'Get the Public Contacts OU
Set objContainer = GetObject(LDAP://OU=Public Contacts,DC=company,DC=com)
TestforContact = False
'Check to see if the e-mail address already exists
For Each adcontact In objContainer
If (CStr (outlookcontact.Email1Address) <> "") And _
(CStr(adcontact.mail) = CStr (outlookcontact.Email1Address)) Then _
TestforContact = True
'Check to see whether this is a new contact with an existing name, but from a different company
If (CStr (adcontact.displayName) = FixedFileAs) And _
(CStr (outlookcontact.CompanyName) = CStr (adcontact.company)) Then _
TestforContact = True
Next
'Create a valid directory name for the contact.
CNName = "CN=" & outlookcontact.FullName
stAddCompany = ""
If DNExists (CNNAME) Then
If outlookcontact.CompanyName = "" Then
TestforContact = True
Else
'If the directory name exists add the company name to it.
CNName = "CN=" & outlookcontact.FullName & " (" & outlookcontact.CompanyName & ")"
If DNExists (CNNAME) Then TestforContact = True
End If
End If
If TestforContact = False then
' Create a Contact
Reportfile.WriteLine "Creating: " & FixedFileAs
Set objContact = objContainer.Create("contact", CNName)
' Now fill the contact attributes in Active Directory
With objContact
.Put "displayName", FixedFileAs
If outlookcontact.LastName <> "" Then _
.Put "sn",CStr(outlookcontact.LastName)
If outlookcontact.FirstName <> "" Then _
.Put "givenName",CStr(outlookcontact.FirstName)
If outlookcontact.CompanyName <> "" Then _
.Put "company" , CStr(outlookcontact.CompanyName)
If outlookcontact.Department <> "" Then _
.Put "department" , CStr(outlookcontact.department)
If outlookcontact.BusinessAddressCity <> "" Then _
.Put "l", CStr(outlookcontact.BusinessAddressCity)
If outlookcontact.Title <> "" Then _
.Put "title", CStr(outlookcontact.Title)
If outlookcontact.WebPage <> "" Then _
.Put "wWWHomePage", CStr(outlookcontact.WebPage)
If outlookcontact.Department <> "" Then _
.Put "department" , CStr(outlookcontact.Department)
If outlookcontact.BusinessAddressStreet <> "" Then _
.Put "streetAddress" , CStr(outlookcontact.BusinessAddressStreet)
If outlookcontact.BusinessAddressPostOfficeBox <> "" Then _
.Put "postOfficeBox" , CStr(outlookcontact.BusinessAddressPostOfficeBox)
If outlookcontact.BusinessAddressPostalCode <> "" Then _
.Put "postalCode" , CStr(outlookcontact.BusinessAddressPostalCode)
If outlookcontact.BusinessAddressState <> "" Then _
.Put "st" , CStr(outlookcontact.BusinessAddressState)
If outlookcontact.BusinessAddressCountry <> "" Then
.Put "co", CStr(outlookcontact.BusinessAddressCountry)
'Open a file containing table of Country Name, Country designation (two characters) and Country Code
'(Numberical code like the one used for dialing)
Set codes = fs.OpenTextFile("c:\countrycodes.csv")
Do While not codes.AtEndOfStream
countryst = codes.ReadLine
countryar = Split (countryst,",")
If countryar(0)= CStr(outlookcontact.BusinessAddressCountry) Then
.Put "c", countryar (1)
.Put "countryCode", CInt(countryar(2))
End If
Loop
End If
If outlookcontact.BusinessTelephoneNumber <> "" Then _
.Put "telephoneNumber" , CStr(outlookcontact.BusinessTelephoneNumber)
If outlookcontact.HomeTelephoneNumber <> "" Then _
.Put "homephone" , CStr(outlookcontact.HomeTelephoneNumber)
If outlookcontact.PagerNumber <> "" Then _
.Put "pager" , CStr(outlookcontact.PagerNumber)
If outlookcontact.MobileTelephoneNumber <> "" then _
.Put "Mobile", CStr(outlookcontact.MobileTelephoneNumber)
'Create the mailNickname (alias) attribute from the e-mail and mail-enable the contact.
If outlookcontact.Email1Address <> "" Then
Set objRecip = objContact
TempAr = Split (outlookcontact.Email1Address,"@")
objRecip.mailNickname = TempAr (0) & "at" & TempAr (1)
FwdAddress = "SMTP:" & outlookcontact.Email1Address
objRecip.MailEnable FwdAddress
End If
.SetInfo
End With
Else
Reportfile.WriteLine "Ignoring " & FixedFileAs
End If
End If
Next
Reportfile.close
Function DNExists (dn)
'Determines if a directory name exists by querying Active Directory using LDAP
DNExists = False
Set rootDSE=GetObject(LDAP://RootDSE)
DomainContainer = rootDSE.Get("defaultNamingContext")
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
ldapStr = "<LDAP://" & DomainContainer & ">;(& (cn=" & Mid (dn,4) & ") );adspath;subtree"
Set rs = conn.Execute(LDAPStr)
If rs.RecordCount = 1 Then DNExists = True
conn.Close
End Function
The most important and somewhat tricky property of them all is the e-mail address. In Active Directory, a contact is assigned a single e-mail address. It is also assigned an Exchange "alias", now called "mailNickname". This property has no real functionality for contacts but it has to be unique in Active Directory for the contact to be created. In the script I create this property by replacing the "@" symbol with the word "at" but it can be any other unique name.
This script cannot migrate more than the first e-mail. A contact needs to be stamped by Exchange before you can add more e-mail addresses, so I provide a second script which should be run after the Exchange RUS has been fired, which usually happens in a range of fifteen minutes after running the contact migration script.
The second script goes through all the contacts in the Public Folder looks for a matching Exchange stamped contact created earlier and adds the e-mail address. Outlook supports three e-mail addresses per contact but I assumed two will suffice. If you need all three e-mail addresses, simply change the field "Email2Address" to "Email3Address" and run the script again.
کد:
Dim objRecip
Dim mycontact' As ContactItem
Dim proxies
'On Error Resume Next
Set rootDSE=GetObject(LDAP://RootDSE)
DomainContainer = rootDSE.Get("defaultNamingContext")
'Open a connection to the Public Contacts public folder
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.Application.GetNamespace("MAPI")
Set myfolder = myNameSpace.Folders("Public Folders"). _
Folders("All Public folders").Folders("Public Contacts")
'Open a connection to Active Directory
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
'Run through all the contacts in the public folder
For I = 1 To myfolder.Items.Count
If TypeName(myfolder.Items.Item(I)) = "ContactItem" Then
Set mycontact = myfolder.Items(I)
' If a contact has a second e-mail address find the first contact in Active Directory
' by using the first e-mail address
If (mycontact.Email2Address <> "") Then
LDAPStr = "<LDAP://" & DomainContainer & _
">;(&(objectCategory=contact)(mail=" _
& mycontact.Email1Address & "));adspath;subtree"
Set rs = conn.Execute(LDAPStr)
If rs.RecordCount = 1 Then
Set oContact = GetObject(rs.Fields(0).Value)
Set objRecip = oContact
'Add the second e-mail address to the contact if it is njot already a property of the contact
sAddress = "smtp:" & mycontact.Email2Address
bIsFound = False
vProxyAddresses = objRecip.ProxyAddresses
nProxyAddresses = UBound(vProxyAddresses)
nProxyAddress = 0
Do While nProxyAddress <= nProxyAddresses
If vProxyAddresses(nProxyAddress) = sAddress Then
bIsFound = True
Exit Do
End If
nProxyAddress = nProxyAddress + 1
Loop
If Not bIsFound Then
ReDim Preserve vProxyAddresses(nProxyAddresses + 1)
vProxyAddresses(nProxyAddresses + 1) = sAddress
objRecip.ProxyAddresses = vProxyAddresses
oContact.SetInfo
End If
End If
End If
End If
Next
conn.Close
Converting Distribution Lists
Distribution lists are a very weak link in Outlook. Since Outlook is not really a directory per-se like Active Directory, there is usually some problem with keeping track of where the contacts that belong to the Distribution List exist. Also, when you do an import or export the reference to the contacts is deleted and all that is left is the e-mail address of the contact which is not updated.
Converting the Distribution list requires to create a Universal Distribution Group in Active Directory for each Distribution List and then look for the contacts that already exist in Active Directory, searching according to their e-mail address.
کد:
Dim MyDl
Dim objRecip
Dim mailar(2)
' On Error Resume Next
Set rootDSE=GetObject(LDAP://RootDSE)
DomainContainer = rootDSE.Get("defaultNamingContext")
Set fs = CreateObject("Scripting.FileSystemObject")
Set userFile = fs.CreateTextFile("c:\DLConvertReport.txt")
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.Application.GetNamespace("MAPI")
'Open a connection to the DLs public folder.
Set myfolder = myNameSpace.Folders("Public Folders"). _
Folders("All Public folders").Folders("DLs")
FindContactinDLs = False
'Go through all the distribution lists in the folder
For I = 1 To myfolder.Items.Count
If TypeName(myfolder.Items.Item(I)) = "DistListItem" Then
Set MyDl = myfolder.Items(I)
' Set the Type of Group as Universal Distribution Group
lGroupType = &H8 'ADS_GROUP_TYPE_UNIVERSAL_GROUP
' Create the Group
Set objContainer = GetObject(LDAP://OU=DLs,DC=company,DC=com)
strGroupName = MyDl.DLName
Set iAdGroup = objContainer.Create("group", "cn=" + strGroupName)
' Create a login name for the group that conforms to the NT4 standards
strSamAcctName = "DL" & Replace(strGroupName, " ", "")
strSamAcctName = Left(strSamAcctName, 12)
'Add a number at the end of login name of the group if it exists
n = 2
If LoginNameExists (strSamAcctName) Then _
strSamAcctName = strSamAcctName & "2"
Do While LoginNameExists (strSamAcctName)
n = n + 1
strSamAcctName = Left (strSamAcctName,12) & CStr (n)
Loop
iAdGroup.Put "sAMAccountName", strSamAcctName
iAdGroup.Put "groupType", lGroupType
userFile.WriteLine "Creating " & strGroupName
' Flush to the directory
iAdGroup.SetInfo
'Mail Enable
Set iMailGroup = iAdGroup
iMailGroup.mail = strSamAcctName & "@company.com"
iMailGroup.MailEnable
' Write Exchange information to the directory.
iAdGroup.SetInfo
' Look for members of the distribution list in Active Directory
For y = 1 To MyDl.MemberCount
Set DLMember = MyDl.GetMember(y)
WScript.Echo DLMember.Name & " " & DLMember.Address
If DLMember.Address <> "" Then
contactMail = MyDl.GetMember(y).Address
recipient =
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
ldapStr = "<LDAP://" & DomainContainer & _
">;(&(&(objectCategory=contact)(!extensionAttribute1=ShowInGAL)" & _
"(&(&(& (| (&(objectCategory=person)(objectClass=contact))" & _
")))(objectCategory=contact)(proxyAddresses=smtp:" & _
CStr(contactMail) & "))));adspath;subtree"
Set rs = conn.Execute(ldapStr)
'If contact is found add it to the corresponding Universal Group
If Not rs.EOF Then
Set oContact = GetObject(rs.Fields(0).Value)
path = oContact.ADsPath
If Not (iAdGroup.IsMember(path)) Then
userFile.WriteLine " Adding Contact " & path
iAdGroup.Add path
iAdGroup.SetInfo
End If
End If
Else
'If member is a Distribution list itself, look for it in Active Directory
'and add it to the Universal Group
DLName = MyDl.GetMember(y).Name
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
ldapStr = "<LDAP://" & DomainContainer _
& ">;(&(&(&(& (mailnickname=*) (| (objectCategory=group) )))(objectCategory=group)(displayName=" & DLName & ")));adspath;subtree"
Set rs = conn.Execute(ldapStr)
If Not rs.EOF Then
Set oUDG = GetObject(rs.Fields(0).Value)
path = oUDG.ADsPath
userFile.WriteLine " Adding DL " & path
If Not (iAdGroup.IsMember(path)) Then
iAdGroup.Add path
iAdGroup.SetInfo
End If
End If
End If
Next
End If
Next
Function LoginNameExists (login)
'Check to see if login name already exists in Active Directory
LoginNameExists = False
Set rootDSE=GetObject(LDAP://RootDSE)
DomainContainer = rootDSE.Get("defaultNamingContext")
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
WScript.Echo login
ldapStr = "<LDAP://" & DomainContainer & _
">;(& (sAMAccountName=" & login & ") );adspath;subtree"
Set rs = conn.Execute(LDAPStr)
If rs.RecordCount = 1 Then LoginNameExists = True
conn.Close
End Function
Conclusion
If the scripts look tricky to you, they are easy to modify to match your Active Directory and e-mail domain. On the other hand, once you learn to master scripting Active Directory and Exchange, the true power of these scripts will reveal itself. The great thing about using a script rather than say a wizard, even a well thought out one like the Outlook Import and Export one is that you get almost absolute flexibility. You can write almost any rule to eliminate unwanted contacts during the migration process. You can decide on whatever naming standard for contacts you choose and make it as complex or as simple as you would like. You can create different contacts in different folders according to any criteria that you choose. The sky is really the limit when it comes to the power of scripting