Outlook 2016のルールで "スクリプトとして実行"機能を置き換える方法は？

Question

"スクリプトとして実行"オプションが削除されているので、Outlookにいくつかの "スクリプト"モジュールがあります。私はITチームに例外を請求しましたが、セキュリティリスクのために付与されていません。その結果、私は以前にしたことをする別の方法を見つけなければなりません。

私は毎週自動化された報告システムから数百の電子メールを受け取り、必要に応じて他のユーザーが消費するためにフォルダや他のアプリケーションにフィルタリングされます。代替としてNewMailItemsオプションを検討しましたが、さまざまなサブルーチンを実行し、ルールの一部としてファイル再配置機能を使用する方法を理解していません。典型的なルールは、電子メールをフォルダに再配置し、それを読み取りとしてマークし、スクリプトによって添付ファイルを処理してから閉じます。

私は同じことをするためにVBAでルール全体を書く必要があると思われますが、ファイル処理における私の経験は弱く、私は実験としていくつかのファイルを壊しています。

これは私が汎用ファイルの例として実行したものです。ユニット番号用のフィルタを持つものもあり、アーカイブのために特定のフォルダにアタッチメントを誘導するものもあります（ずっと長いVBAコード）。終了する前にExcelスプレッドシートを起動し、データをマージするものもあります。私の同僚もこのコードを実行し、いくつかのオーバーヘッドが取り除かれている（フォルダ存在テストなど）ので、データフローは中断されず、スクリプトはエントリを複製しません（私はただの人ですそれを書いて共有します）。データの取り扱いが理解されている、それは私が助けが必要であることをキャプチャしている。

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

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/

私が必要と思うのは、デバッグスクリプトで「echo it out」ではなく、別のルーチンを呼び出すだけです。

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 

私は少し概念的な要素が不足していると思われますので、あなたの経験と推奨は高く評価されます。他の組織が潜在的なマルウェアへの扉を閉じると、Outlookから「スクリプトとして実行」オプションを切ってしまうので、私は孤独にならないと確信しています。

Answer 1

実行中のスクリプトコードはItemAddコードの項目です。

以下の3つの提案はすべて同等です。

提案1 - そのままスクリプトコードを実行してください。

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 - それはアイテムに等しいので、含まれているスクリプトコードを変更することはありません。

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 - 項目

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