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: OutlookFolders in Category Microsoft Outlook : Automation from Total Visual SourceBook

Working with Microsoft Outlook Folders through Automation using VB6 and VBA. Compatible with 32 and 64-bit VBA.

This is similar to COutlookFolders32 without the use of the 32-bit Common Controls of MSComCtl32.ocx.

Procedure List

Procedure Name	Type	Description
(Declarations)	Declarations	Declarations and private variables for the COutlookFolders 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.
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.
GetFolderList	Method	Get a list of folders.
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: OutlookFolders

' Example of the COutlookFolders class
'
' To use this example:
' 1.  Create a new form.
' 2.  Create these command buttons:
'       cmdListMailBox
'       cmdListFolders
'       cmdListFolderItems
'       cmdSaveAttachments
'       cmdEmptyJunkMail
'       cmdTest
' 3.  Create the following textbox:
'       txtMailBoxName
'       txtFolderName
'       txtOutput
' 4.  Run the form

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

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

  Set clsOutlookFolders = New COutlookFolders

  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

    Me.txtOutput = strMsg

  End If
End Sub

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

  Dim strMailBox As String
  Dim clsOutlookFolders As COutlookFolders
  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 COutlookFolders

    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

    Me.txtOutput = 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 COutlookFolders
  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 COutlookFolders
    clsOutlookFolders.StartOutlook

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

    Me.txtOutput = ""
    For intCount = 1 To outFolder.Items.Count
      Me.txtOutput = Me.txtOutput & outFolder.Items(intCount).Subject & vbCrLf
    Next intCount

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

    Set clsOutlookFolders = Nothing
  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 COutlookFolders
  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 COutlookFolders
      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

      Me.txtOutput = lngFiles & " files saved to disk"
    End If
  End If
End Sub

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

  Dim clsOutlookFolders As COutlookFolders
  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 COutlookFolders
    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

    Me.txtOutput = 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 COutlookFolders
  Dim strDate As String
  Dim objItem As Object
  Dim outTestFolder1 As Outlook.MAPIFolder
  Dim outTestFolder2 As Outlook.MAPIFolder
  Dim lngItems As Long

  Me.txtOutput = ""

  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 COutlookFolders

    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)
      Me.txtOutput = Me.txtOutput & "Set RootFolder to: " & clsOutlookFolders.RootFolder.name & vbCrLf

      ' Set the current folder name
      clsOutlookFolders.OpenFolder strMailBox, strFolder
      Me.txtOutput = Me.txtOutput & "Opened folder: " & clsOutlookFolders.CurrentFolder.name & vbCrLf

      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)
      Me.txtOutput = Me.txtOutput & "Test Folder Added" & vbCrLf

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

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

      ' Copy all items from the current folder to the destination folder
      clsOutlookFolders.CopyAllItems
      Me.txtOutput = Me.txtOutput & "All Items copied from: " & clsOutlookFolders.CurrentFolder.name & " to " & clsOutlookFolders.DestinationFolder.name & vbCrLf

      Err.Clear

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

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

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

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

      ' Make the second folder you created the current folder
      clsOutlookFolders.OpenFolder clsOutlookFolders.RootFolder, outTestFolder2.name
      Me.txtOutput = Me.txtOutput & "Set CurrentFolder to: " & clsOutlookFolders.CurrentFolder.name & vbCrLf

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

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

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

      Set objItem = clsOutlookFolders.CurrentFolder.Items.Item(1)
      Me.txtOutput = Me.txtOutput & "Set objItem to: " & objItem.Subject & vbCrLf

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

      Set objItem = clsOutlookFolders.CurrentFolder.Items.Item(1)
      Me.txtOutput = Me.txtOutput & "Set objItem to: " & objItem.Subject & vbCrLf

      Me.txtOutput = Me.txtOutput & "Deleting item: " & objItem.Subject & vbCrLf
      clsOutlookFolders.DeleteItem objItem.EntryID, clsOutlookFolders.DestinationFolder.StoreID

      clsOutlookFolders.MoveAllItems
      Me.txtOutput = Me.txtOutput & "All items moved to Destination Folder" & vbCrLf

      Me.txtOutput = Me.txtOutput & "Deleting folder: " & clsOutlookFolders.CurrentFolder.name & vbCrLf
      clsOutlookFolders.DeleteFolder clsOutlookFolders.CurrentFolder.EntryID, clsOutlookFolders.RootFolder.StoreID

      Me.txtOutput = Me.txtOutput & "Deleting folder: " & clsOutlookFolders.DestinationFolder.name & vbCrLf
      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
      '  Me.txtOutput = Me.txtOutput & "Deleted items folder Emptied" & vbCrLf
      'End If

      If MsgBox("Would you like to close Outlook?", vbYesNo) = vbYes Then
        clsOutlookFolders.CloseOutlook
      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.cmdListFolders
    .Caption = "List Mail Box Folders"
    .Width = 3000
    .Left = 100
    .Top = 1100
  End With

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

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

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

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

  With Me.cmdTest
    .Caption = "Test COutlookFolders"
    .Width = 3000
    .Left = 100
    .Top = 3600
  End With

  With Me.txtOutput
    .Top = 100
    .Left = 3500
    .Width = 7000
    .Height = 10000
  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!