Outlookの特定の基準のみに基づいて添付ファイルを自動転送するにはどうすればよいですか？

著者：シャオヤン最終更新日：2024年08月21日

通常、電子メールを転送するときは、元のメッセージ本文と添付ファイルも含まれます。ただし、場合によっては、基準に基づいて元のメッセージのない添付ファイルのみを特定の人に転送する必要があります。 Outlookでこの仕事をどのように解決できますか？

特定の基準に基づいた添付ファイルのみをVBAコードを使用して自動的に人に転送する

特定の基準に基づいた添付ファイルのみをVBAコードを使用して自動的に人に転送する

たとえば、件名に「kto feature」というテキストが含まれる電子メールを受信すると、この電子メールのすべての添付ファイルは、メッセージ本文なしで特定の人に自動的に転送されます。次の手順が役立ちます。次のようにしてください。

1。を押し続けます Alt + F11 キーを押して アプリケーション向け Microsoft Visual Basic 窓。

2。の中に アプリケーション向け Microsoft Visual Basic ウィンドウ、ダブルクリック このOutlookSession Project1（VbaProject.OTM） ペインでモードを開き、次のコードをコピーして空のモジュールに貼り付けます。

VBAコード：メッセージ本文なしで電子メールを自動転送しますが、添付ファイルのみを含めます。

Public WithEvents ReceivedItems As Outlook.Items
Private Sub Application_Startup()
    Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
    Dim xForwardMail As Outlook.MailItem
    Dim xEmail As MailItem
    On Error Resume Next
    If Item.Class <> olMail Then Exit Sub
    Set xEmail = Item
    If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub  'change subject text to your need
    If xEmail.Attachments.Count = 0 Then Exit Sub
    Set xForwardMail = xEmail.Forward
    With xForwardMail
        .HTMLBody = ""
        With .Recipients
            .Add "skyyang@addin88.com"    'change address to your own
            .ResolveAll
        End With
        .Send
    End With
End Sub

Note：上記のコードでは、件名のテキストと受信者のアドレスを自分のものに変更する必要があります。