Delen via


HOW TO:Iterating through Exchange Mailboxes using CDO 1.21

I have seen many developers wanting to loop through multiple mailboxes either to get the mailbox size or get the number of emails in different folders. Here is a sample that loops through multiple mailboxes recursively.

The following sample is a simple VBScript code sample that iterates through all folders in multiple mailboxes. To use this sample, paste the following code in a new text file, and then name the file Iteratemailboxes.vbs:

 'This script logs on to a server that is running Exchange Server and
'iterates through all the mailboxes recursively.

' USAGE: cscript Iteratemailboxes.vbs SERVERNAME DATAFILE
' This requires that CDO 1.21 is installed on the computer.

Dim obArgs
Dim cArgs
Dim objSession
Dim objInfoStores

' Get command line arguments.
Set obArgs = WScript.Arguments
cArgs = obArgs.Count

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

Main

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

    If cArgs <> 2 Then
        WScript.Echo "Usage: cscript IterateMailboxes.vbs SERVERNAME DATAFILE(Name and Path)"
        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
    Do While Not DataFile.AtEndOfStream
         alias = DataFile.ReadLine
    
        'Loop through the mailboxes
        Call IterateInfoStores(obArgs.Item(0), alias)
    Loop
   
    DataFile.Close

    'Clean Up    
    Set DataFile = Nothing
    Set FileSysObj = Nothing

End Sub


Sub IterateInfoStores(ServerName,UserName)

Dim objFolder
Dim intCounter
Dim objInfoStore
Dim sMsg

    On Error Resume Next
    
    'Create the new Session Object
    Set objSession = CreateObject("MAPI.Session")

    If Err.Number <> 0 Then
      sMsg = "Error creating MAPI.Session."
      sMsg = sMsg & "Make sure CDO 1.21 is installed. "
      sMsg = sMsg & Err.Number & " " & Err.Description
      WScript.Echo sMsg
      Exit Sub
    End If

    'Logon to the Mailbox
    objSession.Logon "", "", False, True, 0, False, ServerName & vbLf & UserName
    
    If Err.Number <> 0 Then
      sMsg = "Error logging on: "
      sMsg = sMsg & Err.Number & " " & Err.Description
      WScript.Echo sMsg
      WScript.Echo "Server: " & ServerName
      WScript.Echo "Mailbox: " & UserName
      Set objSession = Nothing
      Exit Sub
    End If

    WScript.Echo "Logged On to:" & objSession.CurrentUser

    'Loop through the Infostores
    For intCounter = 1 To objSession.InfoStores.Count
        Set objInfoStore = objSession.InfoStores(intCounter)

        If Err.Number <> 0 Then
          sMsg = "Error retrieving InfoStore Object: "
          sMsg = sMsg & Err.Number & " " & Err.Description
          WScript.Echo sMsg
          WScript.Echo "Server: " & ServerName
          WScript.Echo "Mailbox: " & UserName
          Set objInfoStore = Nothing
          Set objSession = Nothing
          Exit Sub
        End If
    
        If objInfoStore.Name = "Mailbox - " & objSession.CurrentUser Then
            Exit For
        End If
    Next
    
    Set objFolder = objInfoStore.RootFolder
    
    If Err.Number <> 0 Then
        sMsg = "Error retrieving RootFolder Object: "
        sMsg = sMsg & Err.Number & " " & Err.Description
        WScript.Echo sMsg
        WScript.Echo "Server: " & ServerName
        WScript.Echo "Mailbox: " & UserName
        Set objInfoStore = Nothing
        Set objFolder = Nothing
        Set objSession = Nothing
        Exit Sub
    End If

    'Recurse through the sub-folders
    NavigateFolders objFolder
    
    'Logoff from the session
    objSession.Logoff

    'Clean Up
    Set objFolder = Nothing
    Set objInfoStore = Nothing
    Set objSession = Nothing
End Sub

Sub NavigateFolders(MAPIFolder)
Dim intCounter
Dim intMessageCounter
Dim objMessage

    On Error Resume Next

    WScript.Echo "Folder Name:" & MAPIFolder.Name

    For intMessageCounter = 1 To MAPIFolder.Messages.Count

        'Implement you own logic here
        Set objMessage = MAPIFolder.Messages(intMessageCounter)
      
        Select Case objMessage.Class
            Case CdoMsg
                 Select Case objMessage.Type
                    Case "IPM.Note"
                        WScript.Echo "Message:" & objMessage.Subject
                    Case "IPM.Appointment"
                        WScript.Echo "Appointment:" & objMessage.Subject
                End Select
        End Select
    Next
    
    If MAPIFolder.Folders.Count > 0 Then
        For intCounter = 1 To MAPIFolder.Folders.Count
            NavigateFolders MAPIFolder.Folders(intCounter)
        Next
    End If

    Set objMessage = Nothing
End Sub

The list of mailboxes 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 iteratemailboxes.vbs Exchange2003 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/

Enjoy!

Comments