在不访问“运行脚本"的情况下执行 VBA 脚本Outlook 2016 中的规则 [英] Executing VBA Script without access to the "Run a Script" rule in Outlook 2016

问题描述

我在工作的计算机上安装了 Outlook 2016，并且运行脚本"规则已被禁用.我知道应该在 regedit 文件中进行的更改，但我需要管理员访问权限才能这样做.我的 IT 团队位于我所在的全国各地，所以我已经等了两周让他们改变这一点，我相信这永远不会发生.

所以，我想知道是否有解决方法或方法来编写相同的过程?

当我收到一封主题行中包含某些词的电子邮件时，我希望规则/脚本将文件附件(电子邮件内)保存到我计算机上的一个文件夹中.

我根本不是 VBA 专家(尤其是 Outlook)，所以我可能离正确的道路还很远，但我已经试过了:

私有子Application_Startup()Dim oRule 作为 Outlook.Rule将 oRuleAction 变暗为 Outlook.RuleAction将 oRuleCondition 变暗为 Outlook.RuleConditionSet oRule = colRules.Create("Transfer Attachment", olRuleSubject)设置 oRuleCondition = oRule.Conditions.Subject("FINAL-CPW GRP SALES")设置 oRuleAction = SaveAtlasReport结束子公共子 SaveAtlasReport()Dim att 作为附件Dim FileName 作为字符串文件名 = "C:UsersWCD1867DocumentsAttachTestPositivePOS.xlsx"att.SaveAsFile 文件名结束子

解决方案

替换您的Outlook 规则/运行脚本"使用 Items.ItemAdd 事件(展望) 和 Items.Restrict 方法 (Outlook) 到 按主题行过滤项目.

示例

私有 WithEvents 项目作为 Outlook.Items私有子 Application_Startup()Dim olNs 作为 Outlook.NameSpace将收件箱调暗为 Outlook.MAPIFolder将过滤器调暗为字符串过滤器 = @SQL =";&Chr(34) &urn:schemas:httpmail:subject"&_Chr(34) &"像 '%FINAL-CPW GRP Sales%' 和 "&_Chr(34) &urn:schemas:httpmail:hasattachment"&_Chr(34) &=1"Set olNs = Application.GetNamespace(MAPI")设置收件箱 = olNs.GetDefaultFolder(olFolderInbox)设置项目 = Inbox.Items.Restrict(Filter)结束子Private Sub Items_ItemAdd(ByVal Item As Object)如果 TypeOf Item 是 Outlook.mailitem 那么Dim AtmtName As StringDim FilePath 作为字符串文件路径 = "C:Temp";Dim Atmt 作为附件对于 Item.Attachments 中的每个 AtmtAtmtName = 文件路径 &文件名Debug.Print AtmtName ' 在立即窗口上打印Atmt.SaveAsFile AtmtName下一个万一结束子

<块引用>

_{Items.ItemAdd 事件(Outlook) 在将一个或多个项目添加到指定集合时发生.当将大量项目一次添加到文件夹时，此事件不会运行.此事件在 Microsoft Visual Basic Sc​​ripting Edition (VBScript) 中不可用.}

---

<块引用>

_{Items.Restrict 方法 是使用 Find 方法或 FindNext 方法迭代集合中特定项目的替代方法.如果项目数量较少，则 Find 或 FindNext 方法比过滤更快.如果集合中有大量项目，Restrict 方法会明显更快，尤其是当预计在大型集合中只能找到少数项目时.}

---

<块引用>

_{使用字符串比较过滤项目 DASL 过滤器支持的包括等价、前缀、短语和子字符串匹配.请注意，当您对 Subject 属性进行过滤时，诸如RE:"之类的前缀将不会出现.和FW:"被忽略.}

---

对于那些想要编辑 reg 的人，请参阅 https://stackoverflow.com/a/48778903/4539709

---

I have Outlook 2016 on my computer at work and the "Run a Script" rule has been disabled. I'm aware of the changes that should be made in the regedit file, but I need admin access to do so. My IT team is located across the country from me, so I've been waiting for two weeks for them to change this and I'm convinced that it's never going to happen.

So, I'm wondering if there's a workaround or a way to code the same process?

When I receive an e-mail with certain words in the subject line, I would like the rule/script to save the file attachment (inside the e-mail) into a folder on my computer.

I'm no VBA expert at all (especially with Outlook), so I'm probably far away from being on the right path, but I've given it a shot:

Private Sub Application_Startup()
    Dim oRule as Outlook.Rule
    Dim oRuleAction as Outlook.RuleAction
    Dim oRuleCondition as Outlook.RuleCondition

    Set oRule = colRules.Create("Transfer Attachment", olRuleSubject)
    Set oRuleCondition = oRule.Conditions.Subject("FINAL-CPW GRP SALES")
    Set oRuleAction = SaveAtlasReport
End Sub

Public Sub SaveAtlasReport()
    Dim att as Attachment
    Dim FileName as string

    FileName = "C:UsersWCD1867DocumentsAttachTestPositivePOS.xlsx"
    att.SaveAsFile FileName

End Sub

解决方案

Replace your "Outlook Rule / Run a Script" with Items.ItemAdd Event (Outlook) and Items.Restrict Method (Outlook) to Filter Items by subject line.

Example

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder
    Dim Filter As String

    Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                       Chr(34) & " Like '%FINAL-CPW GRP SALES%' AND " & _
                       Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                       Chr(34) & "=1"

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items.Restrict(Filter)

End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.mailitem Then
        Dim AtmtName As String
        Dim FilePath As String
            FilePath = "C:Temp"
        
        Dim Atmt As Attachment
        For Each Atmt In Item.Attachments
            AtmtName = FilePath & Atmt.FileName
            Debug.Print AtmtName ' Print on Immediate Window
            Atmt.SaveAsFile AtmtName
        Next
    End If
End Sub

_{Items.ItemAdd Event (Outlook) Occurs when one or more items are added to the specified collection. This event does not run when a large number of items are added to the folder at once. This event is not available in Microsoft Visual Basic Scripting Edition (VBScript).}

---

_{Items.Restrict method is an alternative to using the Find method or FindNext method to iterate over specific items within a collection. The Find or FindNext methods are faster than filtering if there are a small number of items. The Restrict method is significantly faster if there is a large number of items in the collection, especially if only a few items in a large collection are expected to be found.}

---

_{Filtering Items Using a String Comparison that DASL filters support includes equivalence, prefix, phrase, and substring matching. Note that when you filter on the Subject property, prefixes such as "RE: " and "FW: " are ignored.}

---

For those who wanna edit reg see https://stackoverflow.com/a/48778903/4539709

---

这篇关于在不访问“运行脚本"的情况下执行 VBA 脚本Outlook 2016 中的规则的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！