Consulting

Results 1 to 5 of 5

Thread: Outlook New Email event listener

  1. #1
    VBAX Regular
    Joined
    Aug 2021
    Posts
    17
    Location

    Outlook New Email event listener

    I'm building a reminder tool in Excel using Outlook to send data to a user. The user's response data needs to return by the same avenue, through Outlook. To pass the response data from Outlook back to Excel I need to set up some sort of event listener to accomplish the following goals:
    1. Target and bind to the most current email. (This will only ever contain response data from users)
    2. Move the binded email to a separate folder (outside of the Inbox).
    3. Pass the binded email item to a separate macro for further processing. I've built a macro that pulls apart the subject line and the body text so that it can be passed into Excel more easily.
    4. Continue listening for more emails in the Inbox.

    Tl;dr: I need an event listener that will bind to the most current email item - at some point during the macro's execution it needs to move that binded mail item to a separate folder outside of the main Inbox.

    In my own research I've discovered that everything I want to do is totally possible to achieve within the scope of VBA. I'm getting lost putting the pieces together.
    Any help or guidance is deeply appreciated.

  2. #2
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Does this work? This code comes from https://docs.microsoft.com/en-us/office/vba/api/outlook.application.newmail
    Public WithEvents myOlApp As Outlook.Application
    Sub Initialize_handler() 
    Set myOlApp = Outlook.Application 
    End Sub 
    
    Private Sub myOlApp_NewMail() 
    Dim myExplorers As Outlook.Explorers 
    Dim myFolder As Outlook.Folder 
    Dim x As Integer 
    Set myExplorers = myOlApp.Explorers 
    Set myFolder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
    If myExplorers.Count <> 0 Then 
    For x = 1 To myExplorers.Count 
    On Error GoTo skipif 
    If myExplorers.Item(x).CurrentFolder.Name = "Inbox" Then 
    myExplorers.Item(x).Display 
    myExplorers.Item(x).Activate 
    Exit Sub 
    End If
    skipif: 
    Next x 
    End If 
    On Error GoTo 0 
    myFolder.Display 
    End Sub
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    VBAX Regular
    Joined
    Aug 2021
    Posts
    17
    Location
    Without modifying this code at all and just injecting it directly into my Outlook's console, ThisOutlookSession, I get runtime error 91, Object Required.

    Arg. LOL.

  4. #4
    VBAX Regular
    Joined
    Aug 2021
    Posts
    17
    Location
    Update: Found this code block on another forum site. I'm not sure about the rules here for posting links to outside forums so I'll just drop the code block.

    Option Explicit
    
    Private WithEvents inboxItems As Outlook.Items
    
    
    
    Private Sub Application_Startup()
    
      Dim outlookApp As Outlook.Application
    
      Dim objectNS As Outlook.NameSpace
    
    
    
      Set outlookApp = Outlook.Application
    
      Set objectNS = outlookApp.GetNamespace("MAPI")
    
      Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
    
    End Sub
    
    
    
    Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    
    On Error GoTo ErrorHandler
    
    
    
    Dim Msg As Outlook.MailItem
    
    Dim MessageInfo
    
    Dim Result
    
    IfTypeName(Item) = "MailItem"Then
    
        MessageInfo = ""& _
    
    "Sender : "& Item.SenderEmailAddress& vbCrLf & _
    
    "Sent : "& Item.SentOn& vbCrLf & _
    
    "Received : "& Item.ReceivedTime& vbCrLf & _
    
    "Subject : "& Item.Subject& vbCrLf & _
    
    "Size : "& Item.Size& vbCrLf & _
    
    "Message Body : "& vbCrLf & Item.Body
    
        Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
    
    EndIf
    
    
    
    ExitNewItem:
    
        Exit Sub
    
    
    
    ErrorHandler:
    
        MsgBox Err.Number&" - "& Err.Description
    
        Resume ExitNewItem
    
    End Sub
    

  5. #5
    VBAX Regular
    Joined
    Aug 2021
    Posts
    17
    Location
    RESOLUTION:

    Step 1: Set up event listener to grab onto the newest mail item in your top level Inbox folder.

    Option ExplicitPrivate WithEvents inboxItems As Outlook.Items
    Private Sub Application_Startup()
      Dim outlookApp As Outlook.Application
      Dim objectNS As Outlook.NameSpace
      
      Set outlookApp = Outlook.Application
      Set objectNS = outlookApp.GetNamespace("MAPI")
      Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
    End Sub
    Step 2: Actually do something to the bound item:

    Private Sub inboxItems_ItemAdd(ByVal Item As Object)On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    Dim MessageInfo
    Dim Result
    If TypeName(Item) = "MailItem" Then
    'DO SOMETHING TO THE ITEM (In my case I'm calling a macro in a module to do more to this item.)
    End If
    ExitNewItem:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number & " - " & Err.Description
        Resume ExitNewItem
    End Sub
    Step 3: Set up a Module to do what you want to do to the mail item. In my case, I'm breaking apart the subject line for specific pieces of text and reading the content of the body for an integer value.

    Public Sub SendToNB(Item As Outlook.MailItem)'''''''SEND EMAIL TEXT TO EXCEL'''''''''''''
    '''Code by Jakson Kitsune, various others'''
    '''''''''''''Project Start: 8/14/2021'''''''
    ''''''''''''''Last Update: 02/14/2022'''''''
    ''''''''''''''Version: 3.1.0.0''''''''''''''
     
     Dim myNameSpace As Outlook.NameSpace
     Dim myInbox As Outlook.Folder
     Dim myDestFolder As Outlook.Folder
    
    
     Set myNameSpace = Application.GetNamespace("MAPI")
     Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
     Set myDestFolder = myInbox.Folders("Test")
    
    
    
    
    
    
    MsgBox "Send to NB taking over"
    
    With Item
        
        MsgBox "With item"
        
            'Particularly with the subject...
            Subj = Item.Subject
            MsgBox "Subj"
    
    
    '...more execution happens but it's really esoteric and it was all built for my purposes. LOL.

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
  •