电子邮件进入收件箱后触发 Outlook 脚本

Question

我正在尝试完成我的访问系统和 Outlook 之间的集成。

该系统的基础是当一封电子邮件进入特定的收件箱时，Outlook 需要触发一个脚本。该脚本然后打开 Access 数据库并运行它自己的功能来浏览收件箱，获取电子邮件中的附件并将其导入数据库。

目前这两个脚本 "Work" 就 Outlook 调用 Access 和 Access 做这件事而言。问题是当 Outlook 执行脚本时，它是在邮件实际进入邮箱之前。访问应用程序将启动，将收件箱扫描为空，并在邮件实际进入收件箱之前关闭。

我尝试在脚本中添加一个 "Pause" 循环，尝试让它等到电子邮件可读后再打开访问应用程序，但这只是在 [= 期间冻结了 outlook 27=] 而不是让电子邮件变得可读。

这是我在 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

此时：我正在使用 outlook 规则启动脚本：

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

任何帮助都会很棒，因为这是我需要开始工作的最后一块

Answer 1

你可以试试这样的方法，

添加此代码以等待新邮件

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    ThisOutlookSession.GetNamespace("MAPI").GetItemFromID(EntryIDCollection).Subject
    ' Check for the email subject / any property
    'then call your method
End Sub

Answer 2

您不需要规则，按此方式尝试- 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

电子邮件进入收件箱后触发 Outlook 脚本

Trigger an Outlook script after the email has entered the inbox

vba

ms-access

outlook

outlook-2010