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

问题描述

我在工作的计算机上安装了Outlook 2016，并且运行脚本"规则已被禁用.我知道应该在regedit文件中进行的更改，但是我需要管理员权限.我的IT团队遍布我全国各地，因此我一直在等待两个星期，以使他们对此进行更改，并且我坚信这将永远不会发生.

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.

我根本不是VBA专家(尤其是Outlook)，所以我可能离正确的道路还很遥远，但是我给了它一个机会:

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:\Users\WCD1867\Documents\AttachTest\PositivePOS.xlsx"
    att.SaveAsFile FileName

End Sub

推荐答案

替换"Outlook规则/运行脚本"；与 Items.ItemAdd事件(Outlook) 和 Items.Restrict方法(Outlook) 到 示例

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事件(Outlook) .当一个或多个项目添加到指定的集合时发生. 一次将大量项目添加到文件夹中时，该事件不会运行.此事件在Microsoft Visual Basic脚本版(VBScript)中不可用.

_{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).}

---

---

---

对于那些想要编辑注册表的人，请参见 https://stackoverflow.com/a/48778903/4539709

---

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

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