HOWTO: Dump out Contacts using CDOEX and ADO

The following sample is a simple VBScript code sample that that uses CDOEX and ADO to iterate through multiple mailboxes and dumps out the contact data to a text file. This code must be run on the Exchange server.

To use this sample, paste the following code in a new text file, and then name the file DumpContacts.vbs:

 'This script must be run on an Exchange Server.
'USAGE: cscript DumpContacts.vbs DOMAIN Datafile(FullPath)

Dim obArgs
Dim cArgs

Set obArgs = WScript.Arguments
cArgs = obArgs.Count

Main

Sub Main()
Dim FileSysObj
Dim DataFileName
Dim DataFile
Dim alias

Const ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0

   If cArgs <> 2 Then
      WScript.Echo "Usage: cscript DumpContacts.vbs DOMAIN Datafile(FullPath)"
      Exit Sub
   End If

   Set FileSysObj = CreateObject("Scripting.FileSystemObject")

   DataFileName = obArgs.Item(1)

   Set DataFile = FileSysObj.OpenTextFile(DataFileName, ForReading, False,0)

   'Read line by line to get the mailbox alias from the Datafile
   Do While Not DataFile.AtEndOfStream
     alias = DataFile.ReadLine

     'Dump contact data to a csv file
     Call DumpContacts(obArgs.Item(0), alias)
   Loop
   
   DataFile.Close

   'Clean up
   Set DataFile = Nothing
   Set FileSysObj = Nothing

End Sub

Sub DumpContacts(Domain, Mailbox)

Dim Rs
Dim Rec
Dim strURL
Dim sMsg
Dim strLocalPath
Dim ContactData

   On Error Resume Next

  ' Specify the URL to a folder or an item.
  strLocalPath = "MBX/" & Mailbox &"/Contacts"

  Set Rec = CreateObject("ADODB.Record")
  Set Rs = CreateObject("ADODB.Recordset")
  strURL = "file://./backofficestorage/" & Domain & "/" & strLocalPath

  Rec.Open strURL

  If Err.Number <> 0 Then
      sMsg = "Error Connecting to the Contact folder for User " & Mailbox & " "
      sMsg = sMsg & Err.Number & " " & Err.Description
      WScript.Echo sMsg
      Exit Sub
  End If
  
  Set Rs.ActiveConnection = Rec.ActiveConnection

  Rs.Source = "SELECT ""DAV:href"", " & _
          " ""urn:schemas:contacts:email1"", " & _
              " ""urn:schemas:contacts:nickname"", " & _
              " ""urn:schemas:contacts:title"" " & _
              "FROM scope('shallow traversal of """ & strURL & """') "
  Rs.Open

  while Not Rs.EOF

    Dim iPerson
    Set iPerson = Createobject("CDO.Person")
    iPerson.DataSource.Open Rs.Fields("DAV:href").Value, Rec.ActiveConnection

    ContactData = iPerson.Company & ";"
    ContactData = ContactData & iPerson.Email & ";"
    ContactData = ContactData & iPerson.Email2 & ";"
    ContactData = ContactData & iPerson.Email3 & ";"
    ContactData = ContactData & iPerson.FileAs & ";"
    ContactData = ContactData & iPerson.FileAsMapping & ";"
    ContactData = ContactData & iPerson.FirstName & ";"
    ContactData = ContactData & iPerson.HomeCity & ";"
    ContactData = ContactData & iPerson.HomeCountry & ";"
    ContactData = ContactData & iPerson.HomeFax & ";"
    ContactData = ContactData & iPerson.HomePhone & ";"
    ContactData = ContactData & Replace(iPerson.HomePostalAddress, vbcrlf," ") & ";"
    ContactData = ContactData & iPerson.HomePostalCode & ";"
    ContactData = ContactData & iPerson.HomePostOfficeBox & ";"
    ContactData = ContactData & iPerson.HomeState & ";"
    ContactData = ContactData & iPerson.HomeStreet & ";"
    ContactData = ContactData & iPerson.Initials & ";"
    ContactData = ContactData & iPerson.LastName & ";"
    ContactData = ContactData & Replace(iPerson.MailingAddress, vbcrlf," ") & ";"
    ContactData = ContactData & iPerson.MailingAddressID & ";"
    ContactData = ContactData & iPerson.MiddleName & ";"
    ContactData = ContactData & iPerson.MobilePhone & ";"
    ContactData = ContactData & iPerson.NamePrefix & ";"
    ContactData = ContactData & iPerson.NameSuffix & ";"
    ContactData = ContactData & iPerson.Title & ";"
    ContactData = ContactData & iPerson.WorkCity & ";"
    ContactData = ContactData & iPerson.WorkCountry & ";"
    ContactData = ContactData & iPerson.WorkFax & ";"
    ContactData = ContactData & iPerson.WorkPager & ";"
    ContactData = ContactData & iPerson.WorkPhone & ";"
    ContactData = ContactData & Replace(iPerson.WorkPostalAddress, vbcrlf," ") & ";"
    ContactData = ContactData & iPerson.WorkPostalCode & ";"
    ContactData = ContactData & iPerson.WorkPostOfficeBox & ";"
    ContactData = ContactData & iPerson.WorkState & ";"
    ContactData = ContactData & iPerson.WorkStreet & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:weddinganniversary").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:account").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:bday").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:billinginformation").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:businesshomepage").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:co").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:cn").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:computernetworkname").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:dn").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:gender").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:weddinganniversary").Value & ";"
    ContactData = ContactData & iPerson.Fields("urn:schemas:contacts:manager").Value & ";"
    ContactData = ContactData & iPerson.Fields("https://schemas.microsoft.com/exchange/sensitivity").Value & “;”

    WriteFile ContactData 

    Rs.MoveNext

  wend
  
  Rs.Close
  Rec.Close

  'Clean Up  
  Set Rs = Nothing
  Set Rec = Nothing
    
End Sub

Sub WriteFile(Contents)   

Const ForWriting =2 
Const ForAppending = 8

  Set oFS = CreateObject("Scripting.FileSystemObject") 
  Set oFSFile = oFS.OpenTextFile("C:\Contacts.txt",ForAppending,True) 

  oFSFile.WriteLine(Contents) 
  oFSFile.Close 

  Set oFSFile = Nothing 
  Set oFS = Nothing 

End Sub 

The list of mailboxes to scan can be provided via a text file(Datafile). The Datafile contains the aliases of the users(one on each line). So assuming your Datafile is called "Aliases.txt" and is on the C:\, you would run the script as follows:

C:\>Cscript DumpContacts.vbs "MyDomain.com" "C:\Aliases.txt"

The account that you are logged on the computer with must have permissions on the mailboxes that you are trying to iterate through. You can give the permissions by following the steps in the article below:

How to assign service account access to all mailboxes in Exchange Server 2003

https://support.microsoft.com/kb/821897/