Web Listing 1: Script to Purge Items from a Mailbox

Sub PurgeMailbox(serverName, mailboxName)
    Dim cdoSession 'As MAPI.Session
    Dim strProfileInfo 'As String
    Dim store 'As MAPI.InfoStore
    Dim topFolder 'As MAPI.Folder
    Dim subFolder 'As MAPI.Folder
    Dim classField 'As MAPI.Field
    Const cdoPR_CONTAINER_CLASS = &H3613001E
    On Error Resume Next
    
    ' Log on with dynamic MAPI logon.
[BEGIN CALLOUT A]
    Set cdoSession = CreateObject("MAPI.Session")
    strProfileInfo = serverName & vbLf & mailboxName
    cdoSession.Logon "", "", False, True, 0, False, strProfileInfo
[END CALLOUT A]
    ' Get the top folder of the mailbox.
    For Each store In cdoSession.InfoStores
        If store.rootFolder.name = "Top of Information Store" Then
            Set topFolder = store.rootFolder
            Exit For
        End If
    Next
    
    ' Process all folders in the mailbox except contact folders.
    For Each subFolder In topFolder.Folders
        Set classField = subFolder.Fields(cdoPR_CONTAINER_CLASS)
        If Not classField Is Nothing Then
            If UCase(classField.Value) <> "IPF.CONTACT" Then
                Call ProcessCDOFolder(subFolder)
            End If
        End If
    Next
    
    Set subFolder = Nothing
    Set topFolder = Nothing
    cdoSession.Logoff
    Set cdoSession = Nothing
End Sub

Sub ProcessCDOFolder(myFolder)
    Dim subFolder 'As MAPI.Folder
    Const cdoPR_CONTAINER_CLASS = &H3613001E
        
    ' Process items.
    Call DeleteCDOFolderItems(myFolder)
    
    ' Process subfolders, but not contacts folders.
    For Each subFolder In myFolder.Folders
        Set classField = subFolder.Fields(cdoPR_CONTAINER_CLASS)
        If Not classField Is Nothing Then
            If UCase(classField.Value) <> "IPF.CONTACT" Then
                Call ProcessCDOFolder(subFolder)
            End If
        End If
    Next
    
    Set subFolder = Nothing
End Sub

Sub DeleteCDOFolderItems(thisFolder)
    Dim thisMsg 'As MAPI.Message
    Dim count 'As Integer
    Dim j 'As Integer

    ' Delete all messages in the folder.
    count = thisFolder.Messages.count
    For j = count To 1 Step -1
        Set thisMsg = thisFolder.Messages(j)
        thisMsg.Delete
    Next
    
    Set thisMsg = Nothing
End Sub