Trigger an Outlook script after the email has entered the inbox

Question

I'm trying to finalize an integration between my access system and Outlook.

The basis of the system is that Outlook needs to trigger a script when an email enters a specific Inbox. This script then opens the Access DB and runs it's own function to go through that inbox, take the attachment in the email and import it into the database.

Currently both scripts "Work" in so far as Outlook calling Access and Access doing it's thing. The problem is when Outlook executes the script, it's BEFORE the message is actually in the mailbox. The access app will launch, scan the inbox as empty and close just before the message actually enters the inbox.

I've tried adding a "Pause" loop in the script, to try and have it wait until the email is readable before opening the access app, but that just froze outlook for the duration of the "Pause" instead of letting the email become readable.

Here is my script in Outlook:

Sub ExecuteDealRequest(item As Outlook.MailItem)
    Dim currenttime As Date

    currenttime = Now
    Do Until currenttime + TimeValue("00:00:30") <= Now
    Loop

    Dim AccessApp As Access.Application
    Set AccessApp = CreateObject("Access.Application")
    AccessApp.OpenCurrentDatabase ("C:\commHU\Comm HU Request.accdb"), False
    AccessApp.Visible = True
    AccessApp.DoCmd.RunMacro "Macro1"
    Set AccessApp = Nothing
End Sub

At this point: I'm using outlook rules to launch the script:

Apply this rule after the message arrives
With Pricing Request in the Subject
 and on this computer only
Move it to the Pricing Requests folder
 and run Project.ExecuteDealRequest
 and stop processing more rules

Any help would be great, as this is the last piece that I need to get working

Answer 1

You don't need Rule, Try it this way- code in ThisOutlookSession

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf item Is Outlook.MailItem Then
        ExecuteDealRequest Item
    End If
End Sub

' ---- Your Code
Sub ExecuteDealRequest(Item As Outlook.MailItem)
    Dim currenttime As Date
    Dim AccessApp As Access.Application
    Set AccessApp = CreateObject("Access.Application")
    AccessApp.OpenCurrentDatabase ("C:\commHU\Comm HU Request.accdb"), False
    AccessApp.Visible = True
    AccessApp.DoCmd.RunMacro "Macro1"
    Set AccessApp = Nothing
End Sub