如何从 VBA 代码调用 Outlook 的桌面警报

Question

我在 Win XP 上运行 Outlook 2003。我的 Desktop Alert 已开启且运行顺畅。

但最近我创建了一个 VBA 宏，它将传入的电子邮件分类到几个不同的文件夹中（通过 ThisOutlookSession 中的 item_add 事件）。这以某种方式阻止了桌面警报的显示。

有没有办法从 VBA 代码手动调用桌面警报？也许是某种功能。

P.S：我无法通过规则对我的电子邮件进行排序，这不是一个选项

基本上，我正在使用 RegEx 查找电子邮件中的 6 位代码

我的代码（抱歉，这是我在 Internet 上找到的其他代码片段拼凑而成的

Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
On Error Resume Next

Dim targetFolder As Outlook.MAPIFolder
Dim myName As String

Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match

Set Reg1 = New RegExp
myName = "[MyName]"

' \s* = invisible spaces
' \d* = match digits
' \w* = match alphanumeric

With Reg1
    .Pattern = "\d{6}"
    .Global = True
End With

If (InStr(Item.To, myName) Or InStr(Item.CC, myName)) Then    ' if mail is sent or cced to me
    If Reg1.test(Item.Subject) Then
        Set M1 = Reg1.Execute(Item.Subject)
        For Each M In M1
            ' M.SubMatches(1) is the (\w*) in the pattern
            ' use M.SubMatches(2) for the second one if you have two (\w*)
            Set targetFolder = GetFolder([folderPath])  ' function that returns targetFolder
            Exit For
        Next
    End If
    If Not targetFolder Is Nothing Then
        Item.Save
        Item.Move targetFolder
    End If
End If   
End Sub

非常感谢

Answer 1

我只需在移动项目之前在我的代码中添加一个睡眠就可以让它工作。

见 --> https://stackoverflow.com/a/68959008/5079799

例如：

#If VBA7 Then
'Code is running VBA7 (2010 or later).

     #If Win64 Then
     'Code is running in 64-bit version of Microsoft Office.
      Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
     #Else
     'Code is running in 32-bit version of Microsoft Office.
      Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
     #End If

#Else
'Code is running VBA6 (2007 or earlier).

#End If

Public Sub MoveOLItem(objMail As Outlook.MailItem, FolerPathStr As String)
 If FolerPathStr <> "" Then
  Dim olFolder As Outlook.Folder
  Set olFolder = GetFolder(FolerPathStr)
  Sleep 4200
  objMail.Move olFolder
  Debug.Print "Moved Item to " & FolerPathStr
 ElseIf FolerPathStr = "" Then
  Debug.Print "FolderPathStr = ''"
 End If
End Sub

Answer 2

发现这一点可以将规则设置为在没有 VBA 的情况下根据需要工作，以便在您的宏排序时，根据您将传入电子邮件移动到的文件夹显示警报。

https://www.howto-outlook.com/howto/newmailalert.htm

向下滚动到“配置邮件警报以监控所有 [l] 个文件夹；而不仅仅是收件箱。”

配置邮件警报以监控所有文件夹；不仅仅是收件箱 管理规则和警报按钮默认情况下，新的新邮件桌面警报只会在邮件发送到收件箱时显示。这意味着当您将规则配置为将邮件移动到其他文件夹时，通知将不会显示。

要解决此问题，您可以将“显示桌面警报”操作添加到每个规则。除了非常烦人的事实之外，这样做的真正缺点是，当您在 Exchange 组织中时，该规则将成为本地规则，因此它只会在 Outlook 运行时执行。这意味着当您向规则添加额外操作时，例如将其转发到另一个地址，这些操作也不会执行。

一个更好的解决方案是创建一个没有条件的通用规则，只有显示桌面警报的操作。

打开规则和警报对话框； 展望 2007 工具-> 规则和警报... 展望 2010、展望 2013 和展望 2016 文件-> 按钮：管理规则和警报 按钮新规则... 选择“从空白规则开始”并验证是否选中了“当邮件到达时检查邮件”或“对收到的邮件应用规则”。 按下一步进入条件屏幕。 确认未选择任何条件，然后按下一步。 将弹出一条警告，说明此规则将适用于所有消息。按“是”表示这是正确的。 选择“显示桌面警报”操作。 按完成以完成规则。 如果需要，将“显示桌面警报”规则一直移动到顶部。 新邮件桌面警报规则（点击图片放大） 您可以创建一个规则来为您收到的每封邮件显示新邮件桌面警报。

Answer 3

Outlook 对象模型不提供任何用于管理通知的功能。相反，您可以考虑开发一个插件，在其中您可以使用允许模仿内置行为的第三方组件。例如，看一下RadDesktopAlert 组件。

更多信息请参见Walkthrough: Creating Your First Application-Level Add-in for Outlook。