How To Use CDO (1.x) to Loop Through All Mailboxes in the GAL (203019)

MORE INFORMATION

NOTE: To be able to log onto each mailbox, you must have sufficient permissions on each of the mailboxes. The section of the code that retrieves the mailbox names from the GAL needs permission only to view the GAL (as noted in the code), which most users can do. The section of code that loops through the mailboxes in the array needs Service Account Administrator or greater permissions. Service Account Administrator permissions are required due to the fact that the application logs on to all of the mailboxes. Required permissions may also depend on what actions are being performed on each mailbox.

Here are the steps to create an application that will logon to all of the mailboxes in the Global Address List:

1. Create a new project (Standard EXE) in Visual Basic.
2. Remove the form that is automatically added to the project.
3. Add a new module to the project.
4. Add a project reference to the Microsoft CDO 1.2 (or higher) Library
5. Add the following code to the module:

   Const CdoPR_EMS_AB_HOME_MTA = &H8007001E
   
   Sub GetMailboxList (objSession As MAPI.Session, _
                       aMailbox() As String, _
                       aServer() As String)
   
      Dim oGAL             As AddressList
      Dim oAdrEntries      As AddressEntries
      Dim oAdrEntry        As AddressEntry
      Dim iCnt             As Integer
   
      Dim strRawServerInfo As String
      Dim iStartServerName As Integer
      Dim iEndServerName   As Integer
      Dim strHomeServer    As String
      Dim strMailboxName   As String
   
      Dim strFindServer    As String
      strFindServer = "/cn=Configuration/cn=Servers/cn="
   
      Set oGAL = objSession.AddressLists("Global Address List")
      Set oAdrEntries = oGAL.AddressEntries
       
      iCnt = 0
      For Each oAdrEntry In oAdrEntries
   
         'Ensure that only mailboxes are included, not custom recipients,
         'distribution lists, or public folder entries in the GAL
         If oAdrEntry.DisplayType = CdoUser Then
   
            'Get the Home Server information from the AddressEntry 
            'Fields collection
            strRawServerInfo = oAdrEntry.Fields(CdoPR_EMS_AB_HOME_MTA)
            iStartServerName = InStr(1, strRawServerInfo, _
                               strFindServer) + Len(strFindServer)
            iEndServerName = InStr(iStartServerName, strRawServerInfo, "/")
            strHomeServer = Mid(StrRawServerInfo, iStartServerName, _
                            iEndServerName - iStartServerName)
   
            'Get the mailbox name of AddressEntry
            strMailboxName = oAdrEntry.Fields(CdoPR_ACCOUNT).Value
   
            Debug.Print "Server: " & strHomeServer
            Debug.Print "Mailbox: " & strMailboxName
               
            iCnt = iCnt + 1
            ReDim Preserve aMailbox(iCnt)
            ReDim Preserve aServer(iCnt)
            aServer(iCnt) = strHomeServer
            aMailbox(iCnt) = strMailboxName
               
         End If
      Next
       
      Set oAdrEntry = Nothing
      Set oAdrEntries = Nothing
      Set oGAL = Nothing
   
   End Sub
   
   Private Sub Main()
       
      Dim oSession As MAPI.Session
      ReDim aMailboxList(1) As String
      ReDim aserverlist(1) As String
      Dim iBigLoop As Integer
       
      Dim sServerName As String
      Dim sProfileInfo As String
       
      'TO DO: Change "ServerName" to the name of your Exchange Server
      sServerName = "ServerName"
      
      'TO DO: Change "MailboxName" to the name of a mailbox on the
      '  server specified above
      sProfileInfo = sServerName & vbLf & "MailboxName"
   
      Set oSession = CreateObject("MAPI.Session")
      oSession.Logon profileinfo:=sProfileInfo
   
      GetMailboxList oSession, aMailboxList, aserverlist
       
      oSession.Logoff
       
      For iBigLoop = 1 To UBound(aMailboxList)
         sProfileInfo = aserverlist(iBigLoop) & vbLf & aMailboxList(iBigLoop)
           
         oSession.Logon profileinfo:=sProfileInfo
         Debug.Print oSession.CurrentUser.Name
   
         ' Do any processing here for each mailbox
   
         oSession.Logoff
      Next iBigLoop
   
      Set oSession = Nothing
   
   End Sub
   					

6. Compile and run the project.