Total Visual SourceBook

Total Visual SourceBook CD and Printed Manual

Microsoft Access/ Office 2016, 2013, 2010, and 2007 Version
is Shipping!

New features in Total Visual SourceBook for Access, Office 2007 and VB6

Supports Access/Office 2016, 2013, 2010 and 2007, and Visual Basic 6.0!

Separate version for Access/Office 2003, 2002, and 2000.

Separate version for:
Access 97/95


View all FMS products for Microsoft AccessAll Our Microsoft Access Products

SourceBook Info:

Why SourceBook?

 

"The code is exactly how I would like to write code and the algorithms used are very efficient and well-documented."

Van T. Dinh, Microsoft MVP

 

 

 

Microsoft Access, Office/VBA, VB6 Modules royalty-free source code libraryMicrosoft Access Modules royalty-free source code libraryMicrosoft 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

Microsoft Access Module LibraryOverview 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.

Additional Resources