如何替换“以脚本方式运行"； Outlook 2016规则中的功能? [英] How to replace the "Run as Script" functionality in Outlook 2016 Rules?

问题描述

由于我们的系统中已删除了以脚本运行"选项，因此Outlook中有许多脚本"模块已被禁用.

I have a number of "script" modules in Outlook that have been disabled as the "Run as Script" option has been removed in our system.

为活动项目处理以脚本运行"文件的示例:

An example of "Run as Script" file handling for an active project:

Public Sub saveAVMAttachtoDisk(itm As Outlook.MailItem)

'Prepare variables
Dim objAtt As Outlook.Attachment

'Identify destination folders:
'Engineering AVM Daily Fault folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder1 As String
    saveFolder1 = "\\Dc3fap002\groups$\Transit Engineering\Reliability MDBF\AVM\Daily Reports\"

'Engineering AVM Oil Pressure Analysis folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder2 As String
    saveFolder2 = "\\Dc3fap002\groups$\Transit Engineering\Project Management\Fluid Life Oil Analysis\AVM Oil Pressure Study\AVM Data\"

Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")

'Save file
     For Each objAtt In itm.Attachments
     'Saves each Daily Fault Summary Report
          If InStr(objAtt.DisplayName, "OC Transpo - Daily Fault Summary Report") Then
               objAtt.SaveAsFile saveFolder1 & "\" & objAtt.DisplayName
          End If

      'Saves each Oil Pressure File with the date and time (to prevent overwriting)
          If InStr(objAtt.DisplayName, "Engine Oil Pressure") Then
           objAtt.SaveAsFile saveFolder2 & "\" & dateFormat & " " & objAtt.DisplayName
          End If

      'Clears the Attachment for the purposes of the loop
          Set objAtt = Nothing
     Next

End Sub

我已经尝试使用以下NewMailItem检测代码，但是我正在将数据扰乱到错误的文件夹中，并且在上线一次试用时不小心删除/覆盖了某些内容(没有适当的安全性和错误处理代码).这是未经调整的原始代码，来自: https://www .slipstick.com/developer/processing-incoming-e-mails-with-macros/

I have experimented with the following NewMailItem detection code, but I am scrambling data into the wrong folders, and I accidentally deleted / overwrote some when I went live one trial (didn't have all the safeties and error handling code in place). This is the unadjusted raw code from: https://www.slipstick.com/developer/processing-incoming-e-mails-with-macros/

我认为这是我所需要的，我只需要对其执行操作(调用另一个例程)，而不是在调试脚本中将其回显"即可.

I think it is what I need, I just need to act on it (call another routine) instead of "echo it out" in a debug script.

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objNewMailItems As Outlook.Items

Private Sub Application_Startup()

Dim objMyInbox As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set objMyInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objNewMailItems = objMyInbox.Items
Set objMyInbox = Nothing
End Sub


Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
'Ensure we are only working with e-mail items
If Item.Class <> olMail Then Exit Sub

Debug.Print "Message subject: " & Item; .Subject
Debug.Print "Message sender: " & Item; .SenderName & " (" & Item; .SenderEmailAddress & ")";
End Sub

推荐答案

itm在运行时的脚本代码是ItemAdd代码中的项目.

itm in the run a script code is item in the ItemAdd code.

以下所有三个建议都是等效的.

All of the following three suggestions are equivalent.

建议1-重用按原样运行脚本代码.

Suggestion 1 - Reuse run a script code as is.

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
    'Ensure we are only working with e-mail items
    If Item.Class <> olMail Then Exit Sub

    saveAVMAttachtoDisk item

End Sub

建议2-将itm设置为item，以便在包含的运行脚本代码中保持不变.

Suggestion 2 - set itm equal to item so there are no changes in the included run a script code.

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)

    'Ensure we are only working with e-mail items
    If Item.Class <> olMail Then Exit Sub

    dim itm as mailitem
    set itm = item

    'Prepare variables
    Dim objAtt As Outlook.Attachment

    'Identify destination folders:
    'Engineering AVM Daily Fault folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
    Dim saveFolder1 As String
    saveFolder1 = "\\Dc3fap002\groups$\Transit Engineering\Reliability MDBF\AVM\Daily Reports\"

    'Engineering AVM Oil Pressure Analysis folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
    Dim saveFolder2 As String
    saveFolder2 = "\\Dc3fap002\groups$\Transit Engineering\Project Management\Fluid Life Oil Analysis\AVM Oil Pressure Study\AVM Data\"

    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")

    'Save file
    For Each objAtt In itm.Attachments
        'Saves each Daily Fault Summary Report
        If InStr(objAtt.DisplayName, "OC Transpo - Daily Fault Summary Report") Then
            objAtt.SaveAsFile saveFolder1 & "\" & objAtt.DisplayName
        End If

        'Saves each Oil Pressure File with the date and time (to prevent overwriting)
        If InStr(objAtt.DisplayName, "Engine Oil Pressure") Then
            objAtt.SaveAsFile saveFolder2 & "\" & dateFormat & " " & objAtt.DisplayName
        End If

        'Clears the Attachment for the purposes of the loop
        Set objAtt = Nothing
    Next

End Sub

建议3-用item替换itm实例

Suggestion 3 - replace instances of itm with item

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)

'Ensure we are only working with e-mail items
If Item.Class <> olMail Then Exit Sub

'Prepare variables
Dim objAtt As Outlook.Attachment

'Identify destination folders:
'Engineering AVM Daily Fault folder is as follows:
'\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder1 As String
saveFolder1 = "\\Dc3fap002\groups$\Transit Engineering\Reliability MDBF\AVM\Daily Reports\"

'Engineering AVM Oil Pressure Analysis folder is as follows:
'\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder2 As String
saveFolder2 = "\\Dc3fap002\groups$\Transit Engineering\Project Management\Fluid Life Oil Analysis\AVM Oil Pressure Study\AVM Data\"

Dim dateFormat
dateFormat = Format(item.ReceivedTime, "yyyy-mm-dd H-mm")

'Save file
For Each objAtt In item.Attachments
    'Saves each Daily Fault Summary Report
    If InStr(objAtt.DisplayName, "OC Transpo - Daily Fault Summary Report") Then
        objAtt.SaveAsFile saveFolder1 & "\" & objAtt.DisplayName
    End If

    'Saves each Oil Pressure File with the date and time (to prevent overwriting)
    If InStr(objAtt.DisplayName, "Engine Oil Pressure") Then
        objAtt.SaveAsFile saveFolder2 & "\" & dateFormat & " " & objAtt.DisplayName
    End If

    'Clears the Attachment for the purposes of the loop
    Set objAtt = Nothing
Next

End Sub

这篇关于如何替换“以脚本方式运行"； Outlook 2016规则中的功能?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！