Migrating Contacts and Distribution Lists from Outlook to Active Directory

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.

Leave a Comment

Your email address will not be published.

This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

Scroll to Top