Outlook“运行脚本"规则不会触发传入消息的 VBA 脚本 [英] Outlook "Run Script" rule not triggering VBA script for incoming messages

问题描述

我正在根据另一位成员的建议创建这个新主题.有关事情如何到达这一点的其他历史记录，请参阅this问题.

我有这个 VBA 脚本，我知道它可以如果被触发.如果我将 TestLaunch 子例程与已在我的收件箱中符合规则标准的消息一起使用(但是，当然，没有被规则启动)，它会激活我希望它完美激活的链接.如果我在创建规则时说要将其应用于收件箱中的所有现有邮件，则它可以完美运行.然而，在需要的地方，新消息到达时不需要.

我知道脚本没有被触发，因为如果我有这样的规则:

启用了播放声音"的 Outlook新消息"规则>

播放声音"作为其中的一部分，当消息从两个指定的发件人中的任何一个到达时，声音总是会播放，因此正在触发规则.我已经从规则中删除了声音播放部分，并将其集成到 VBA 代码中以进行测试:

选项显式私有声明函数 ShellExecute _Lib "shell32.dll" 别名 "ShellExecuteA" ( _ByVal hWnd As Long, _ByVal 操作为字符串，_ByVal 文件名作为字符串，_可选的 ByVal 参数作为字符串，_可选的 ByVal 目录作为字符串，_可选的 ByVal WindowStyle As Long = vbMinimizedFocus _) 只要私有声明函数 sndPlaySound32 _库winmm.dll"_别名sndPlaySoundA"(_ByVal lpszSoundName 作为字符串，_ByVal uFlags As Long) As LongSub PlayTheSound(ByVal WhatSound As String)如果 Dir(WhatSound, vbNormal) = "" 然后' WhatSound 不是文件.获取名为的文件' WindowsMedia 目录中的 WhatSound.WhatSound = Environ("SystemRoot") &"媒体" &什么声音如果 InStr(1, WhatSound, ".") = 0 然后' 如果 WhatSound 没有 .wav 扩展名，'加一个.WhatSound = WhatSound &.wav"万一如果 Dir(WhatSound, vbNormal) = vbNullString 那么Beep ' 找不到文件.做一个简单的哔哔声.退出子万一别的' WhatSound 是一个文件.用它.万一sndPlaySound32 WhatSound, 0&' 最后，播放声音.结束子公共子 OpenLinksMessage(olMail As Outlook.MailItem)Dim Reg1 作为 RegExpDim AllMatches 作为 MatchCollectionDim M As MatchDim strURL As StringDim RetCode As Long设置 Reg1 = 新的 RegExp使用 Reg1.Pattern = "(https?[:]//([0-9a-z=?:/.&-^!#$;_])*)".Global = 真.IgnoreCase = 真结束于PlayTheSound "chimes.wav"' 如果邮件正文中 URL 的正则表达式测试发现一个或多个如果 Reg1.test(olMail.Body) 那么' 使用 RegEx 将匹配它的所有实例返回到 AllMatches 组设置 AllMatches = Reg1.Execute(olMail.Body)对于 AllMatches 中的每个 MstrURL = M.SubMatches(0)' 不要激活任何用于取消订阅的 URL；跳过它们如果 InStr(1, strURL, "unsubscribe") 然后转到 NextURL' 如果 URL 以 > 结尾从被包围在飞镖中，去掉 >离开如果 Right(strURL, 1) = ">"然后 strURL = Left(strURL, Len(strURL) - 1)' 要激活以接受的 URL 必须包含 IF 语句中的两个子字符串如果 InStr(1, strURL, ".com") 那么PlayTheSound "TrainWhistle.wav"' 激活该链接以接受工作RetCode = ShellExecute(0, "打开", "http://nytimes.com")设置 Reg1 = 无退出子万一下一个网址:下一个万一设置 Reg1 = 无结束子私有子 TestLaunchURL()将 currItem 变暗为 MailItem设置 currItem = ActiveExplorer.Selection(1)OpenLinksMessage currItem结束子

如果 VBA 脚本在所有情况下都被触发，它应该播放chimes.wav"，如果我的实际链接激活处理发生，则播放TrainWhistle.wav".当新邮件到达时，这两种情况都不会发生，但如果 Outlook 规则上有播放声音"应运行此脚本，则播放声音.

目前我有宏的信任中心设置来允许所有，因为 Outlook 在测试过程的早期对使用 selfcert.exe 进行签名时很胡思乱想.我真的希望能够再次提升宏保护，而不是在这一切完成后让它们处于全部运行"状态.

但是，首先，我终生无法弄清楚为什么这个脚本可以通过调试器完美运行，或者如果应用于现有邮件，但不会被应用于现有邮件的相同 Outlook 规则触发，当实际的新消息到达.在 Outlook 2010 下，我正在开发此脚本，以及在 Outlook 2016 下，在部署它的朋友的机器上都是如此.

任何有关解决此问题的指导将不胜感激.

解决方案

这是最终有效的代码.很明显，olMail 的 .Body 成员在某种幕后处理有时间发生之前不可用，如果您等待的时间不够长，那么当您去测试使用它时，它就不会出现.关注公共子 OpenLinksMessage

显然，允许进行该处理的主要更改是添加了以下代码行:Set InspectMail = olMail.GetInspector.CurrentItem.运行此 set 语句所需的时间允许 .Body 在 Outlook 规则传入的 olMail 参数上变得可用.有趣的是，如果您在 set 语句之后立即显示 InspectMail.Body，它会显示为空，就像 olMail.Body 过去那样.

选项显式私有声明函数 ShellExecute _Lib "shell32.dll" 别名 "ShellExecuteA" ( _ByVal hWnd As Long, _ByVal 操作为字符串，_ByVal 文件名作为字符串，_可选的 ByVal 参数作为字符串，_可选的 ByVal 目录作为字符串，_可选的 ByVal WindowStyle As Long = vbMinimizedFocus _) 只要公共子 OpenLinksMessage(olMail As Outlook.MailItem)将 InspectMail 调暗为 Outlook.MailItemDim Reg1 作为 RegExpDim AllMatches 作为 MatchCollectionDim M As MatchDim strURL As StringDim SnaggedBody 作为字符串Dim RetCode As Long' 以下 Set 语句的目的是严格地消耗时间"，以便 .Body 成员' olMail 在下面需要时可用.如果没有这个声明，.Body 始终是' 显示为空.有趣的是，如果您在使用 MsgBox 之后立即显示 InspectMail.Body' 这个 Set 语句显示为空.设置 InspectMail = olMail.GetInspector.CurrentItem设置 Reg1 = 新的 RegExp使用 Reg1.Pattern = "(https?[:]//([0-9a-z=?:/.&-^!#$;_])*)".Global = 真.IgnoreCase = 真结束于RetCode = Reg1.Test(olMail.Body)' 如果邮件正文中 URL 的正则表达式测试发现一个或多个如果 RetCode 那么' 使用 RegEx 将匹配它的所有实例返回到 AllMatches 组设置 AllMatches = Reg1.Execute(olMail.Body)对于 AllMatches 中的每个 MstrURL = M.SubMatches(0)' 不要激活任何用于取消订阅的 URL；跳过它们如果 InStr(1, strURL, "unsubscribe") 然后转到 NextURL' 如果 URL 以 > 结尾从被包围在飞镖中，去掉 >离开如果 Right(strURL, 1) = ">"然后 strURL = Left(strURL, Len(strURL) - 1)' 要激活以接受的 URL 必须包含 IF 语句中的两个子字符串如果 InStr(1, strURL, ".com") 那么' 激活该链接以接受工作RetCode = ShellExecute(0, "Open", strURL)设置 InspectMail = 无设置 Reg1 = 无设置 AllMatches = 无设置 M = 无退出子万一下一个网址:下一个万一设置 InspectMail = 无设置 Reg1 = 无设置 AllMatches = 无设置 M = 无结束子

特别感谢 niton 的耐心和帮助.

I am creating this new topic on the advice of another member. For additional history regarding how things arrived at this point see this question.

I have this VBA script, that I know works if it gets triggered. If I use the TestLaunch subroutine with a message already in my inbox that meets the rule criteria (but, of course, isn't being kicked off by the rule) it activates the link I want it to activate flawlessly. If, when I create the rule I say to apply it to all existing messages in my inbox, it works flawlessly. However, where it's needed, when new messages arrive it does not.

I know that the script is not being triggered because if I have a rule like this:

Outlook "New Message" rule that has "play sound" enabled

with "Play a sound" as part of it, the sound always plays when a message arrives from either of the two specified senders, so the rule is being triggered. I have removed the sound playing part from the rule, and integrated it into the VBA code for testing purposes instead:

Option Explicit

Private Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long

Private Declare Function sndPlaySound32 _
    Lib "winmm.dll" _
    Alias "sndPlaySoundA" ( _
        ByVal lpszSoundName As String, _
        ByVal uFlags As Long) As Long

Sub PlayTheSound(ByVal WhatSound As String)
    If Dir(WhatSound, vbNormal) = "" Then
        ' WhatSound is not a file. Get the file named by
        ' WhatSound from the WindowsMedia directory.
        WhatSound = Environ("SystemRoot") & "Media" & WhatSound
        If InStr(1, WhatSound, ".") = 0 Then
            ' if WhatSound does not have a .wav extension,
            ' add one.
            WhatSound = WhatSound & ".wav"
        End If
        If Dir(WhatSound, vbNormal) = vbNullString Then
            Beep            ' Can't find the file. Do a simple Beep.
            Exit Sub
        End If
    Else
        ' WhatSound is a file. Use it.
    End If

    sndPlaySound32 WhatSound, 0&    ' Finally, play the sound.
End Sub

Public Sub OpenLinksMessage(olMail As Outlook.MailItem)

 Dim Reg1 As RegExp
 Dim AllMatches As MatchCollection
 Dim M As Match
 Dim strURL As String
 Dim RetCode As Long

Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=?:/.&-^!#$;_])*)"
 .Global = True
 .IgnoreCase = True
End With

PlayTheSound "chimes.wav"

' If the regular expression test for URLs in the message body finds one or more
If Reg1.test(olMail.Body) Then

'      Use the RegEx to return all instances that match it to the AllMatches group
       Set AllMatches = Reg1.Execute(olMail.Body)
       For Each M In AllMatches
               strURL = M.SubMatches(0)
'              Don't activate any URLs that are for unsubscribing; skip them
               If InStr(1, strURL, "unsubscribe") Then GoTo NextURL
'              If the URL ends with a > from being enclosed in darts, strip that > off
               If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
'              The URL to activate to accept must contain both of the substrings in the IF statement
               If InStr(1, strURL, ".com") Then
                     PlayTheSound "TrainWhistle.wav"
'                    Activate that link to accept the job
                     RetCode = ShellExecute(0, "Open", "http://nytimes.com")
                     Set Reg1 = Nothing
                     Exit Sub
               End If

NextURL:
   Next

End If

Set Reg1 = Nothing

End Sub

Private Sub TestLaunchURL()
    Dim currItem As MailItem
    Set currItem = ActiveExplorer.Selection(1)
    OpenLinksMessage currItem
End Sub

which should play "chimes.wav" if the VBA script is triggered in all cases and play "TrainWhistle.wav" if my actual link activation processing occurs. When new messages arrive, neither happens, yet if there is a "Play sound" on the Outlook rule that should run this script that sound gets played.

At the moment I have the Trust Center settings for macros to allow all, as Outlook was being cranky about signing that used selfcert.exe earlier in the testing process. I would really like to be able to elevate the macro protections again rather than leave them at "run all" when this is all done.

But, first and foremost, I cannot for the life of me figure out why this script will run perfectly via the debugger or if applied to existing messages, but is not triggered by the very same Outlook rule applied to existing messages when an actual new message arrives. This is true under Outlook 2010, where I'm developing this script, and also under Outlook 2016, on a friend's machine where it's being deployed.

Any guidance on resolving this issue would be most appreciated.

解决方案

Here is the code that finally works. It's clear that the .Body member of olMail is not available until some sort of behind the scenes processing has had time to occur and if you don't wait long enough it won't be there when you go to test using it. Focus on the Public Sub OpenLinksMessage

The major change that allowed that processing to take place, apparently, was the addition of the line of code: Set InspectMail = olMail.GetInspector.CurrentItem. The time it takes for this set statement to run allows the .Body to become available on the olMail parameter that's passed in by the Outlook rule. What's interesting is that if you immediately display InspectMail.Body after the set statement it shows as empty, just like olMail.Body used to.

Option Explicit

Private Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long



Public Sub OpenLinksMessage(olMail As Outlook.MailItem)

 Dim InspectMail As Outlook.MailItem
 Dim Reg1 As RegExp
 Dim AllMatches As MatchCollection
 Dim M As Match
 Dim strURL As String
 Dim SnaggedBody As String
 Dim RetCode As Long

' The purpose of the following Set statement is strictly to "burn time" so that the .Body member of
' olMail is available by the time it is needed below.  Without this statement the .Body is consistently
' showing up as empty.  What's interesting is if you use MsgBox to display InspectMail.Body immediately after
' this Set statement it shows as empty.
Set InspectMail = olMail.GetInspector.CurrentItem

Set Reg1 = New RegExp

With Reg1
 .Pattern = "(https?[:]//([0-9a-z=?:/.&-^!#$;_])*)"
 .Global = True
 .IgnoreCase = True
End With

RetCode = Reg1.Test(olMail.Body)
' If the regular expression test for URLs in the message body finds one or more
If RetCode Then
'      Use the RegEx to return all instances that match it to the AllMatches group
       Set AllMatches = Reg1.Execute(olMail.Body)
       For Each M In AllMatches
               strURL = M.SubMatches(0)
'              Don't activate any URLs that are for unsubscribing; skip them
               If InStr(1, strURL, "unsubscribe") Then GoTo NextURL
'              If the URL ends with a > from being enclosed in darts, strip that > off
               If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
'              The URL to activate to accept must contain both of the substrings in the IF statement
               If InStr(1, strURL, ".com") Then
'                    Activate that link to accept the job
                     RetCode = ShellExecute(0, "Open", strURL)
                     Set InspectMail = Nothing
                     Set Reg1 = Nothing
                     Set AllMatches = Nothing
                     Set M = Nothing
                     Exit Sub
               End If

NextURL:
   Next

End If

Set InspectMail = Nothing
Set Reg1 = Nothing
Set AllMatches = Nothing
Set M = Nothing

End Sub

Special thanks to niton for his patience and assistance.

这篇关于Outlook“运行脚本"规则不会触发传入消息的 VBA 脚本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！