vba - Outlook 2016 ルールの「スクリプトとして実行」機能を置き換える方法は?

Question

「スクリプトとして実行」オプションがシステムで削除されたため、無効になっている Outlook の「スクリプト」モジュールが多数あります。

アクティブなプロジェクトの「スクリプトとして実行」ファイル処理の例:

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 検出コードを試してみましたが、間違ったフォルダーにデータをスクランブルしており、1 回の試用版を公開したときに誤って一部を削除または上書きしてしまいました (すべての安全性とエラー処理コードが配置されていませんでした)。これは、 https ://www.slipstick.com/developer/processing-incoming-e-mails-with-macros/ からの未調整の生コードです。

デバッグスクリプトで「エコーアウト」するのではなく、それに基づいて行動する（別のルーチンを呼び出す）必要があるだけです。

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