How to replace the “Run as Script” functionality in Outlook 2016 Rules?

问题

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

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

回答1:

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

All of the following three suggestions are equivalent.

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

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

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

来源：https://stackoverflow.com/questions/45743223/how-to-replace-the-run-as-script-functionality-in-outlook-2016-rules

标签

outlook-vba

outlook-2016