Article ID: 203019
Article Last Modified on 7/13/2004
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
171440 INFO: Where to acquire the CDO libraries (all versions)
177851 How To Build a CDO (1.x) messaging application to run from a service
200018 INFO: Differences between CDO, Simple MAPI, and Extended MAPI
262054 XADM: How to get service account access to all mailboxes in Exchange 2000
291169 OL2002: General information about CDO 1.21s
Keywords: kbhowto kbmsg KB203019