Microsoft Access, Office/VBA, VB6 Modules royalty-free source code library

Microsoft Access Modules royalty-free source code library

Microsoft Access VBA and VB6 Module Library

Free trial of Total Visual SourceBook for Microsoft Access, Office, VB6 and VBA

Class: OutlookFolders32 in Category Microsoft Outlook : Automation from Total Visual SourceBook

Working with Microsoft Outlook Folders through Automation using VB6 and VBA (32-bit only).

Note that this code is not supported in the 64-bit version of Access 2010 or 2013 due to the use of the Common Controls of MSComCtl32.ocx.

Procedure List

Procedure Name	Type	Description
(Declarations)	Declarations	Declarations and private variables for the COutlookFolders32 class.
AppNameSpace	Property	Get a handle to the current instance of the Outlook NameSpace.
AppOutlook	Property	Get a handle to the current instance of Outlook.
CurrentFolder	Property	Get a handle to the Current Folder.
DestinationFolder	Property	Get a handle to the Destination Folder for Move and Copy Actions.
FoldersTree	Property	Get a handle to the TreeView you want to populate with Folders.
LastErrDescription	Property	Get the description of the last error generated.
LastErrNumber	Property	Get the error number of the last error generated.
RootFolder	Property	Get a handle to the Root Folder.
Class_Initialize	Initialize	Initialize internal variables.
AddFolder	Method	Adds a new folder.
CopyAllItems	Method	Copies all items from the current folder to the destination folder.
CopyItem	Method	Copies an item from the current folder to the destination folder.
DeleteAllItems	Method	Delete all items from the current folder.
DeleteFolder	Method	Delete a folder.
DeleteItem	Method	Delete an item from the current folder.
EmptyDeletedItemsFolder	Method	Empties the "Deleted Items" folder.
EmptyJunkMailFolder	Method	Empties the "Junk E-Mail" folder with optional filter on the received time.
EmptyFolder	Method	Empties the specified folder with optional filter on the received time.
GetFolderFilter	Private	Create the filter string to limit the folder items to a date range.
FoldersToTreeView	Method	Converts the passed folder reference into a treeview structure.
GetFolderList	Method	Get a list of folders.
ItemsToListView	Method	Converts the items in the "CurrentFolder.Items" collection to a listview structure. The CurrentFolder Property must be set before calling this method.
MoveAllItems	Method	Move all items from the current folder to the destination folder.
MoveItem	Method	Move an item from the current folder to the destination folder.
OpenFolder	Method	Set the Current folder.
SaveAttachmentsToDisk	Method	Saves all email attachments from messages in the current Outlook folder to disk. Set the current folder by using the OpenFolder method.
StartOutlook	Method	Starts an instance of Outlook.
Class_Terminate	Terminate	Clean up class variables opened for Outlook.
CloseOutlook	Method	Close an instance of Outlook.

Example Code for Using Class: OutlookFolders32

' Example of the COutlookFolders32 class
'
' To use this example:
' 1.  Create a new form.
' 2.  Create these command buttons:
'       cmdListMailBox
'       cmdListFolders
'       cmdListFolderItems
'       cmdSaveAttachments
'       cmdEmptyJunkMail
'       cmdFillTreeview
'       cmdFillListview
'       cmdTest
' 3.  Create the following textbox:
'       txtMailBoxName
'       txtFolderName
' 4.  Create the following TreeView: TV1
' 5.  Create the following ListView: LV1
' 6.  Run the form

Private Sub cmdListMailBox_Click()
  ' Get the list of Outlook root folder (mailbox) names

  Dim clsOutlookFolders As COutlookFolders32
  Dim outRootFolders As Outlook.Folders
  Dim strMsg As String
  Dim intCount As Integer

  Set clsOutlookFolders = New COutlookFolders32

  clsOutlookFolders.StartOutlook

  If clsOutlookFolders.LastErrNumber <> 0 Then
    MsgBox clsOutlookFolders.LastErrDescription, vbExclamation, "Outlook Failed to Start"
  Else
    Set outRootFolders = clsOutlookFolders.GetFolderList

    strMsg = "These are the root folder names:" & vbCrLf
    If outRootFolders.Count > 0 Then
      For intCount = 1 To outRootFolders.Count
        strMsg = strMsg & vbCrLf & outRootFolders.Item(intCount).name
      Next intCount

      If Nz(Me.txtMailBoxName) = "" Then
        Me.txtMailBoxName = outRootFolders.Item(1).name
      End If
    End If

    MsgBox strMsg

  End If
End Sub

Private Sub cmdListFolders_Click()
  ' Display the list of folders in a mailbox

  Dim strMailBox As String
  Dim clsOutlookFolders As COutlookFolders32
  Dim outFolder As Outlook.MAPIFolder
  Dim intCount As Integer
  Dim strMsg As String
  Dim strSeparator As String

  strMailBox = Nz(Me.txtMailBoxName)
  If strMailBox = "" Then
    MsgBox "Please enter a Mailbox name", vbInformation
    Me.txtMailBoxName.SetFocus
  Else
    Set clsOutlookFolders = New COutlookFolders32

    clsOutlookFolders.StartOutlook

    ' Set root folder to the specified name
    Set outFolder = clsOutlookFolders.GetFolderList.Item(strMailBox)

    strMsg = "These are the " & outFolder.Folders.Count & " folder names in [" & strMailBox & "]:" & vbCrLf & vbCrLf
    If outFolder.Folders.Count > 0 Then
      ' Use a separate line for each folder if there are fewer than 30
      If outFolder.Folders.Count < 30 Then
        strSeparator = vbCrLf
      Else
        strSeparator = "; "
      End If
      For intCount = 1 To outFolder.Folders.Count
        strMsg = strMsg & outFolder.Folders(intCount).name & strSeparator
      Next intCount

      If Nz(Me.txtFolder) = "" Then
        ' Use the last folder as the example
        Me.txtFolder = outFolder.Folders(outFolder.Folders.Count).name
      End If
    End If

    MsgBox strMsg

    Set clsOutlookFolders = Nothing
  End If

End Sub

Private Sub cmdListFolderItems_Click()
  ' Get the list of items in a folder

  Dim strMailBox As String
  Dim strFolder As String
  Dim clsOutlookFolders As COutlookFolders32
  Dim outFolder As Outlook.MAPIFolder
  Dim intCount As Integer

  strMailBox = Nz(Me.txtMailBoxName)
  strFolder = Nz(Me.txtFolder)
  If strMailBox = "" Then
    MsgBox "Please enter a Mailbox name", vbInformation
    Me.txtMailBoxName.SetFocus
  ElseIf strFolder = "" Then
    MsgBox "Please enter a folder name", vbInformation
    Me.txtFolder.SetFocus
  Else
    Set clsOutlookFolders = New COutlookFolders32
    clsOutlookFolders.StartOutlook

    ' Set root folder to the specified name
    Set outFolder = clsOutlookFolders.GetFolderList.Item(strMailBox).Folders(strFolder)

    For intCount = 1 To outFolder.Items.Count
      Debug.Print outFolder.Items(intCount).Subject
    Next intCount

    MsgBox outFolder.Items.Count & " items listed in the Immediate Window"

    Set clsOutlookFolders = Nothing
  End If

End Sub

Private Sub cmdFillTreeview_Click()
  ' Comments: Fill treeview with the folders from Outlook

  Dim strMailBox As String
  Dim clsOutlookFolders As COutlookFolders32
  Dim outRootFolder As Outlook.MAPIFolder

  strMailBox = Nz(Me.txtMailBoxName)
  If strMailBox = "" Then
    MsgBox "Please enter a Mailbox name", vbInformation
    Me.txtMailBoxName.SetFocus
  Else
    DoCmd.Hourglass True
    Set clsOutlookFolders = New COutlookFolders32

    clsOutlookFolders.StartOutlook

    ' Assign the starting folder for the treeview
    Set outRootFolder = clsOutlookFolders.GetFolderList.Item(strMailBox)

    ' Assign the treeview control to update
    Set clsOutlookFolders.FoldersTree = Me.tv1.Object

    clsOutlookFolders.FoldersToTreeView "", outRootFolder, 0

    Set clsOutlookFolders = Nothing

    DoCmd.Hourglass False

    MsgBox "Treeview is filled"
  End If

End Sub

Private Sub cmdFillListview_Click()
  ' Comments: Fill listview with the items in the current Outlook folder

  Dim strMailBox As String
  Dim strFolder As String
  Dim clsOutlookFolders As COutlookFolders32

  strMailBox = Nz(Me.txtMailBoxName)
  strFolder = Nz(Me.txtFolder)
  If strMailBox = "" Then
    MsgBox "Please enter a Mailbox name", vbInformation
    Me.txtMailBoxName.SetFocus
  ElseIf strFolder = "" Then
    MsgBox "Please enter a folder name", vbInformation
    Me.txtFolder.SetFocus
  Else
    Set clsOutlookFolders = New COutlookFolders32

    clsOutlookFolders.StartOutlook

    Set clsOutlookFolders.RootFolder = clsOutlookFolders.GetFolderList.Item(strMailBox)

    ' Assign the folder with the messages to retrieve
    clsOutlookFolders.OpenFolder strMailBox, strFolder

    ' Fill the listview control
    clsOutlookFolders.ItemsToListView Me.lv1.Object, Me.lv1.Width

    Set clsOutlookFolders = Nothing

    MsgBox "Listview is filled"
  End If

End Sub

Private Sub cmdSaveAttachments_Click()
  ' Comments: Save the attachments in any messages in the current Outlook folder to individual files on disk

  Dim strMailBox As String
  Dim strFolder As String
  Dim clsOutlookFolders As COutlookFolders32
  Dim strPath As String
  Dim lngFiles As Long

  strMailBox = Nz(Me.txtMailBoxName)
  strFolder = Nz(Me.txtFolder)
  If strMailBox = "" Then
    MsgBox "Please enter a Mailbox name", vbInformation
    Me.txtMailBoxName.SetFocus
  ElseIf strFolder = "" Then
    MsgBox "Please enter a folder name", vbInformation
    Me.txtFolder.SetFocus
  Else
    strPath = InputBox("Specify the full path to save the attachments from messages in your " & strFolder & " folder", , "C:\Total Visual SourceBook 2013\Samples\")
    If strPath <> "" Then
      Set clsOutlookFolders = New COutlookFolders32
      clsOutlookFolders.StartOutlook

      Set clsOutlookFolders.RootFolder = clsOutlookFolders.GetFolderList.Item(strMailBox)

      ' Assign the folder containing the messages with attachments to save
      clsOutlookFolders.OpenFolder strMailBox, strFolder

      lngFiles = clsOutlookFolders.SaveAttachmentsToDisk(strPath)

      Set clsOutlookFolders = Nothing

      MsgBox lngFiles & " files saved to disk"
    End If
  End If
End Sub

Private Sub cmdEmptyJunkMail_Click()
  ' Comments: Empty the Junk Email folder

  Dim clsOutlookFolders As COutlookFolders32
  Dim lngFiles As Long
  Dim strDate As String
  Dim datLast As Date

  strDate = InputBox("Delete all Junk Email Items before this date")
  If strDate <> "" Then
    datLast = CDate(strDate)

    Set clsOutlookFolders = New COutlookFolders32
    clsOutlookFolders.StartOutlook

    lngFiles = clsOutlookFolders.EmptyJunkMailFolder(0, datLast)

    ' Can also be called with the more general routine to empty a default folder name
    'lngFiles = clsOutlookFolders.EmptyFolder(olFolderJunk, 0, datLast)

    Set clsOutlookFolders = Nothing

    MsgBox lngFiles & " files deleted from the Junk Email folder"
  End If
End Sub

Private Sub cmdTest_Click()
  ' Comments: Step through this code line by line to see how the Outlook folders class works
  '           This procedure creates two folders, copies items from your folder to them, deletes some, and moves them around.
  '           At the end, it deletes the folders it created.

  Dim strMailBox As String
  Dim strFolder As String
  Dim clsOutlookFolders As COutlookFolders32
  Dim strDate As String
  Dim objItem As Object
  Dim outTestFolder1 As Outlook.MAPIFolder
  Dim outTestFolder2 As Outlook.MAPIFolder
  Dim lngItems As Long

  strMailBox = Nz(Me.txtMailBoxName)
  strFolder = Nz(Me.txtFolder)
  If strMailBox = "" Then
    MsgBox "Please enter a Mailbox name", vbInformation
    Me.txtMailBoxName.SetFocus
  ElseIf strFolder = "" Then
    MsgBox "Please enter a folder name", vbInformation
    Me.txtFolder.SetFocus
  Else
    Set clsOutlookFolders = New COutlookFolders32

    clsOutlookFolders.StartOutlook

    If clsOutlookFolders.LastErrNumber <> 0 Then
      MsgBox clsOutlookFolders.LastErrDescription, vbExclamation, "Outlook Failed to Start"
    Else
      ' Specify the root level mail box
      Set clsOutlookFolders.RootFolder = clsOutlookFolders.GetFolderList.Item(strMailBox)
      Debug.Print "Set RootFolder to: " & clsOutlookFolders.RootFolder.name

      ' Set the current folder name
      clsOutlookFolders.OpenFolder strMailBox, strFolder
      Debug.Print "Opened folder: " & clsOutlookFolders.CurrentFolder.name

      strDate = CStr(Now)

      ' Create a folder at the root level with the current time in the name
      Set outTestFolder1 = clsOutlookFolders.AddFolder("Test_" & strDate, clsOutlookFolders.RootFolder)
      Debug.Print "Test Folder Added"

      ' Create another folder at the root level
      Set outTestFolder2 = clsOutlookFolders.AddFolder("Test2_" & strDate, clsOutlookFolders.RootFolder)
      Debug.Print "Test Folder 2 Added"

      ' Set one of the new folders as the destination folder
      Set clsOutlookFolders.DestinationFolder = outTestFolder1
      Debug.Print "Destination Folder set to: " & clsOutlookFolders.DestinationFolder.name

      ' Copy all items from the current folder to the destination folder
      clsOutlookFolders.CopyAllItems
      Debug.Print "All Items copied from: " & clsOutlookFolders.CurrentFolder.name & " to " & clsOutlookFolders.DestinationFolder.name

      Err.Clear

      ' Make the previous destination folder the current folder
      clsOutlookFolders.OpenFolder clsOutlookFolders.RootFolder, clsOutlookFolders.DestinationFolder.name
      If Err.Number = 0 Then
        Debug.Print "Current folder is: " & clsOutlookFolders.CurrentFolder.name

        ' Make the second folder we created the new destination folder
        Set clsOutlookFolders.DestinationFolder = outTestFolder2
        Debug.Print "Destination Folder is: " & clsOutlookFolders.DestinationFolder.name

        ' Copy all items from the current folder to the new destination folder
        lngItems = clsOutlookFolders.CopyAllItems()
        Debug.Print lngItems & " items copied from: " & clsOutlookFolders.CurrentFolder.name & " to " & clsOutlookFolders.DestinationFolder.name

        ' Delete all items from the current folder permanently (it's not stored in the Deleted folder)
        lngItems = clsOutlookFolders.DeleteAllItems()
        Debug.Print lngItems & " deleted from folder: " & clsOutlookFolders.CurrentFolder.name
      End If

      ' Make the second folder you created the current folder
      clsOutlookFolders.OpenFolder clsOutlookFolders.RootFolder, outTestFolder2.name
      Debug.Print "Set CurrentFolder to: " & clsOutlookFolders.CurrentFolder.name

      ' Make the first folder you created the new destination folder
      Set clsOutlookFolders.DestinationFolder = outTestFolder1
      Debug.Print "Destination Folder set to: " & clsOutlookFolders.DestinationFolder.name
      Debug.Print "Destination Folder Item Count = " & clsOutlookFolders.DestinationFolder.Items.Count

      ' Examples of using an object item to manipulate folder items directly
      Set objItem = clsOutlookFolders.CurrentFolder.Items.Item(1)
      Debug.Print "Set objItem to: " & objItem.Subject

      clsOutlookFolders.CopyItem objItem.EntryID, clsOutlookFolders.CurrentFolder.StoreID
      Debug.Print "Item " & objItem.Subject & " copied to Destination Folder"
      Debug.Print "Destination Folder Item Count = " & clsOutlookFolders.DestinationFolder.Items.Count

      Set objItem = clsOutlookFolders.CurrentFolder.Items.Item(1)
      Debug.Print "Set objItem to: " & objItem.Subject

      clsOutlookFolders.MoveItem objItem.EntryID, clsOutlookFolders.CurrentFolder.StoreID
      Debug.Print "Item " & objItem.Subject & " Moved to Destination Folder"
      Debug.Print "Destination Folder Item Count = " & clsOutlookFolders.DestinationFolder.Items.Count

      Debug.Print "Deleting folder : " & clsOutlookFolders.CurrentFolder.name
      clsOutlookFolders.DeleteFolder clsOutlookFolders.CurrentFolder.EntryID, clsOutlookFolders.RootFolder.StoreID

      Debug.Print "Deleting folder : " & clsOutlookFolders.DestinationFolder.name
      clsOutlookFolders.DeleteFolder clsOutlookFolders.DestinationFolder.EntryID, clsOutlookFolders.RootFolder.StoreID

      ' Uncomment this code to delete all items from the Deleted Items folder.
      'If MsgBox("Do you really want to delete items from your Deleted Items folder?", vbYesNo) = vbYes Then
      '  clsOutlookFolders.EmptyDeletedItemsFolder
      '  Debug.Print "Deleted items folder Emptied"
      'End If
    End If
    Set clsOutlookFolders = Nothing
  End If
End Sub

Private Sub Form_Load()
  With Me.cmdListMailBox
    .Caption = "List Mail Box Names"
    .Width = 3000
    .Left = 100
    .Top = 100
  End With

  With Me.txtMailBoxName
    .Width = 3000
    .Left = 100
    .Top = 600
  End With

  With Me.cmdFillTreeview
    .Caption = "Fill Treeview"
    .Width = 3000
    .Left = 100
    .Top = 1100
  End With

  With Me.cmdListFolders
    .Caption = "List Mail Box Folders"
    .Width = 3000
    .Left = 100
    .Top = 1600
  End With

  With Me.txtFolder
    .Width = 3000
    .Left = 100
    .Top = 2100
  End With

  With Me.cmdListFolderItems
    .Caption = "List Folder Items"
    .Width = 3000
    .Left = 100
    .Top = 2600
  End With

  With Me.cmdSaveAttachments
    .Caption = "Save Attachments"
    .Width = 3000
    .Left = 100
    .Top = 3100
  End With

  With Me.cmdEmptyJunkMail
    .Caption = "Empty Junk Mail Folder"
    .Width = 3000
    .Left = 100
    .Top = 3600
  End With

  With Me.cmdFillListview
    .Caption = "Fill Listview"
    .Width = 3000
    .Left = 100
    .Top = 4100
  End With

  With Me.cmdTest
    .Caption = "Test COutlookFolders32"
    .Width = 3000
    .Left = 4000
    .Top = 3000
  End With

  With Me.tv1
    .Top = 100
    .Left = 3500
    .Width = 4000
    .Height = 2500
  End With

  With Me.lv1
    .Top = 4600
    .Left = 100
    .Width = 8000
    .Height = 5000
  End With

End Sub

Overview of Total Visual SourceBook

The source code in Total Visual Sourcebook includes modules and classes for Microsoft Access, Visual Basic 6 (VB6), and Visual Basic for Applications (VBA) developers. Easily add this professionally written, tested, and documented royalty-free code into your applications to simplify your application development efforts.

Total Visual SourceBook is written for the needs of a developer using a source code library covering the many challenges you face. Countless developers over the years have told us they learned some or much of their development skills and tricks from our code. You can too!