Consulting

Results 1 to 8 of 8

Thread: VBA Event Trigger - when email message is moved into a folder

  1. #1

    VBA Event Trigger - when email message is moved into a folder

    Hi, what is the appropriate event trigger that runs a block of code when an email is moved into a particular folder?

    E.g. another scenario Private Sub Items_ItemAdd(ByVal item As Object) triggers when a new item is received

    Preferably this code will run when the folder receives the mail message (as opposed to when the message is moved out of the origin folder)

    Include example code and documentation if possible

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    FolderChange Event

    See Also Applies To Example Specifics
    Occurs when a folder in the specified Folders collection is changed. This event is not available in VBScript.
    Sub object_FolderChange(ByVal Folder As MAPIFolder)

    object An expression that evaluates to a Folders collection object.
    Folder Required. The MAPIFolder that was changed.
    Example

    This example prompts the user to remove a folder from the Deleted Items folder if the folder is empty. The sample code must be placed in a class module, and the Initialize_handler routine must be called before the event procedure can be called by Microsoft Outlook.
    Dim myolapp As New Outlook.Application
    Dim WithEvents myFolders As Outlook.Folders
    
    Sub Initialize_handler()
        Set myNS = myolapp.GetNamespace("MAPI")
        Set myFolders = myNS.GetDefaultFolder(olFolderDeletedItems).Folders
    End Sub
    
    Private Sub myFolders_FolderChange(ByVal Folder As Outlook.MAPIFolder)
        If Folder.Items.Count = 0 Then
            MyPrompt = Folder.Name & " is empty. Do you want to delete it?"
            If MsgBox(MyPrompt, vbYesNo + vbQuestion) = vbYes Then
                Folder.Delete
            End If
        End If
    End Sub
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    How do you retrieve/access the new MailMessage object from a folder when that MailMessage has just been moved into the folder? (whether it is unread or not)

  4. #4
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Referring to the Stack Overflow page above

    Private WithEvents Items As Outlook.Items 
    Private Sub Application_Startup()
      Dim olApp As Outlook.Application
    
      Set olApp = Outlook.Application
      Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Stuff").Items
    End Sub
    
    Private Sub Items_ItemAdd(ByVal item As Object)
    
      On Error GoTo ErrorHandler
    
      MsgBox "You moved an item into the 'Stuff' folder."
    
    ProgramExit:
      Exit Sub
    ErrorHandler:
      MsgBox Err.Number & " - " & Err.Description
      Resume ProgramExit
    End Sub
    
    Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
      Set GetNS = app.GetNamespace("MAPI")
    End Function
    So if I want to modify the code to refer to another folder, do I write the folder items variable as

    Set ThisFolderItems = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("ThisFolder").Items
    and change the event name to

    Private Sub ThisFolderItems_ItemAdd(ByVal item As Object)
    Would this work?

    I have several folders I would like to keep track of when any item is moved to one of these folders, e.g. Folder1Items, Folder2Items, Folder3Items etc. how do I do this?
    Last edited by Cheesecube; 05-07-2020 at 08:01 PM.

  6. #6
    You need to set up a sub for each folder e.g.

    Option Explicit
    
    Private WithEvents Items1 As Outlook.Items
    Private WithEvents Items2 As Outlook.Items
    Private WithEvents Items3 As Outlook.Items
    'etc
    
    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    
        Set olApp = Outlook.Application
        Set Items1 = GetNS(olApp).GetDefaultFolder(olFolderInbox).folders("Folder1Items").Items
        Set Items2 = GetNS(olApp).GetDefaultFolder(olFolderInbox).folders("Folder2Items").Items
        Set Items3 = GetNS(olApp).GetDefaultFolder(olFolderInbox).folders("Folder3Items").Items
        'etc
    End Sub
    
    Private Sub Items1_ItemAdd(ByVal item As Object)
      On Error GoTo ErrorHandler
      MsgBox "You moved an item into the 'Folder1Items' folder."
    ProgramExit:
      Exit Sub
    ErrorHandler:
      MsgBox Err.Number & " - " & Err.Description
      Resume ProgramExit
    End Sub
    
    Private Sub Items2_ItemAdd(ByVal item As Object)
      On Error GoTo ErrorHandler
      MsgBox "You moved an item into the 'Folder1Items2' folder."
    ProgramExit:
      Exit Sub
    ErrorHandler:
      MsgBox Err.Number & " - " & Err.Description
      Resume ProgramExit
    End Sub
    
    Private Sub Items3_ItemAdd(ByVal item As Object)
      On Error GoTo ErrorHandler
      MsgBox "You moved an item into the 'Folder1Items' folder."
    ProgramExit:
      Exit Sub
    ErrorHandler:
      MsgBox Err.Number & " - " & Err.Description
      Resume ProgramExit
    End Sub
    
    'etc
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    Would just like to understand the logic behind the naming convention

    so from the variable name for Outlook.Items,

    Set VarName = GetNS(olApp).GetDefaultFolder(olFolderInbox).folders("Folder1Items").Items
    just name the Sub as

    Private Sub VarName_ItemAdd(ByVal item As Object)
    ?

  8. #8
    Essentially yes, though don't forget
    Private WithEvents VarName As Outlook.Items
    at the top of the module.
    "Folder1Items" is the name of the sub folder
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •