【Outlook-VBA】メールの受信時に添付ファイルを保存する

こんにちは。blueです。

今回はOutlook VBAのイベントマクロを使った添付ファイル取得マクロについて説明します。

この記事を読むと

メール受信時に自動的に添付ファイルを取得する
添付ファイルを送信者ごとにフォルダ分けする

ことができるようになります。

注意点として今回のマクロは導入後は受信時に自動的に発動するようになります。使用については自己責任でお願いします。

以下注意点です。

①今回のイベントマクロ（NewMailEx)はMicrosft Exchangeを使用している場合はOutlookを起動している間しか機能しません。Outlookを閉じている間に受信したメールについては処理されないので注意ください。

内容については以下の記事が参考になります。

Outlook 研究所

Exchange/Office 365/Outlook.com 環境で NewMailEx が動作しない場合がある

https://outlooklab.wordpress.com/2019/11/02/exchange-office-365-outlook-com-環境で-newmailex-が動作しない場合がある/

コメントにて以下のご要望をいただきました。いつも参考にさせていただいております。特定の題名のメ…

(なおMicrosoft Exchangeを使用しているかの確認はOutlookメニューバーの「ファイル」タブで確認できます。以下であればMicrosft Exchangeです）

②フォルダ作成時に使用する送信者名はOutlookのSenderNameプロパティから取得します。

しかしこの文字列に禁則文字（/や\など）が含まれているとフォルダ作成ができずエラーになります。

このエラーが出た場合はLike演算子, Instr関数, Replace関数などを使用して消去してやるとよいです。
禁則文字の処理マクロについては以下の記事を参考ください。

【Excel VBA】禁則文字列の処理マクロを3つ紹介します！

こんにちはblueです。VBAでファイルの保存を行う時、文字列の問題で「不正な文字です」といったエラーが出ることがありませんか？これはファイル名に…

Outlook VBAでメール業務を効率化したい人にはこちらの書籍がお勧めです。

Excel VBAユーザーのためのOutlook VBA入門 (技術の泉シリーズ（NextPublishing）)

Amazonで見る楽天市場で見る Yahoo!ショッピングで見る

返信メールの下書きや日報作成など、煩雑な作業が一瞬でできるようになります。

またオブジェクト構造などの説明もあるので、慣れればOutlook上で行うほぼすべての作業を自動化させることができます。

はじめに
今回のフロー
全コード
各コードの説明
ここでのまとめ

はじめに

イベントマクロとは何かの操作を行ったときに実行される処理のことです。

イベントマクロは各オブジェクトの変化を起点として色々な処理をさせることができます。

なおOutlook VBAの代表的なイベントマクロは[Microsoft Outlook Object]の[ThisOutlookSession]に用意されています。

具体的には以下のプロジェクトウィンドウ内の[ThisOutlookSession]をクリックしたところになります。

この中のオブジェクトボックスが対象オブジェクト、プロシージャボックスが具体的なイベントとなります。

今回はオブジェクトボックスからApplication、プロシージャボックスからNewMailExを選択します。

選択すると以下のコードが自動で表示されます。

なお最初から備わっているイベントマクロの場合イベント名や引数は自動で表示されます。自分で記載する必要はありません。

ちなみに選択時に自動的にItemSendなどのイベントが表示される場合があります。今回は不要ですので削除しておいてください。

今後はこのプロシージャ内に記載していきます。標準モジュールに記載しても動きませんので注意してください。

今回のフロー

今回のフローは以下になります。

事前に添付ファイルを保存するフォルダを指定する
メールを受け取ったらIDからメールの内容を取得する
受け取ったメールについて添付ファイルの有無を確認する
存在する場合は送信者名のフォルダの存在可否を判断し、無ければ作成する
送信者名のフォルダに添付ファイルを保存する

線を引いたところがOutlook VBAならではのコードです。

以降で詳しく説明していきます。

全コード

上記のフローに対するコードは以下になります。途中にある”保存するフォルダ名”は自由に入れてください。なお再度となりますが使用の際は自己責任でお願いします。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
    Dim EntryIDs As Variant
    Dim objId As Object
    Dim myNamespace As NameSpace
    Dim myFolder As String
    Dim strFileName As String
    Dim SenderName As String
    Dim SenderNameFolder As String
    Dim i As Long, j As Long
         
 
    myFolder = "保存するフォルダパス”
     
    EntryIDs = Split(EntryIDCollection, ",")
    Set myNamespace = GetNamespace("MAPI")
     
    For i = 0 To UBound(EntryIDs)
      Set objId = myNamespace.GetItemFromID(EntryIDs(i))
      If objId.Attachments.Count <> 0 Then
          If InStr(objId.SenderName, "@") > 0 Then
            SenderName = Left(objId.SenderName, InStr(objId.SenderEmailAddress, "@") - 1) '送信者のファイル名
          Else
            SenderName = objId.SenderName
          End If
        SenderNameFolder = myFolder & "\" & SenderName  '送信者のフォルダ名
           
        If Dir(SenderNameFolder, vbDirectory) = "" Then '送信者のフォルダ名存在可否判断
          MkDir (SenderNameFolder)
        End If
       
        For j = 1 To objId.Attachments.Count
          strFileName = objId.Attachments.Item(j).FileName
          objId.Attachments.Item(j).SaveAsFile SenderNameFolder & "\" & strFileName  '送信者のフォルダにファイルを保存
        Next j
      End If
    Next i
Stop
End Sub

各コードの説明

事前に添付ファイルを保存するフォルダを指定する

事前に保存するフォルダを作成し、添付ファイルを保存するフォルダパスをmyFolderとします。

このフォルダの下に各送信者の名前を持つフォルダを作成します。

メールを受け取ったらIDからメールを取得する

NewMailExイベントではイベント発動時にEntryIdCollectionが取得できます。

ただし複数メールを同時受信した場合 [,]で区切られるようです。

(2021/10/13未検証：複数にわかれたものを取得できていません）

その為一応Split関数でIDを分けます。EntryIDsのデータ型はVariantになることに注意ください。

またOutlookに関するデータ一式はGetNameSpaceメソッドで取得できるのでセットしておきます。引数はMAPI一択になります。

NameSpaceオブジェクトの説明についてはこちら

Excel VBAでのOutlook操作をできる限りわかりやすく説明する

今回はOutlook VBAについて説明します。Outlook VBAはほかのOffice系ソフトのような詳しい説明や書籍がなく、少し書いてあきらめたりわからないままサ…

EntryIDs = Split(EntryIDCollection, ",")
Set myNamespace = GetNamespace("MAPI")

今後このEntryIDsに対して情報を取得していくことになります。

受け取ったメールについて添付ファイルの有無を確認する

受け取ったメールオブジェクト(objID)の中身をオブジェクトブラウザで見てみると以下のようになっています（実際に見る際は途中にStopを入れたり、ブレークポイントを作成するなどしてデバッグ状態になるようにしておいてください）。

ID情報からメールデータを取得することでEntry IDやSubject, SenderNameやCC, BCCなどの情報を取得できていることがわかります。

またこのメールオブジェクト内にAttachmentsも存在しており、その中にCountプロパティが存在していることがわかります。

以下ではSplit関数で取得したEntryIDsの一つ一つに対してobjID.AttachementsのCountが0でないときに以降の処理を実行させています。

For i = 0 To UBound(EntryIDs)
      Set objId = myNamespace.GetItemFromID(EntryIDs(i)) 
If objId.Attachments.Count <> 0 Then

存在する場合は送信者名のフォルダの存在可否を判断し、無ければ作成する

添付ファイルが存在する場合に送信者のメールアドレスから送信者情報を取得します。

ここではメールアドレスの＠より前の情報を抜き出してSenderNameとしています。

(2021/10/13補足：Exchangeの場合サーバーに登録されたアドレスは”特定の表示名”で表示されメールアドレスでは表示されません。その為ここでは@がある場合とない場合で条件分岐させています）

さらに最初のmyFolderと結合して送信者フォルダ名（SenderNameFolder）としています。

If InStr(objId.SenderName, "@") > 0 Then
            SenderName = Left(objId.SenderName, InStr(objId.SenderEmailAddress, "@") - 1)
          Else
            SenderName = objId.SenderName

次にその送信者フォルダが存在するかをDir関数で確認し、存在しない場合はMkDirで新しいフォルダを作成しています。

If Dir(SenderNameFolder, vbDirectory) = "" Then '送信者のフォルダ名存在可否判断
          MkDir (SenderNameFolder)
      End If

Dir関数は引数に指定したファイルが存在するかを確認する関数ですが第2引数としてvbDirectoryを指定することでフォルダの存在を確認できます。

送信者名のフォルダに添付ファイルを保存する

最後に各フォルダに添付ファイルを保存します。

添付ファイルは先のCount分存在する為その回数分処理します。

For j = 1 To objId.Attachments.Count
            strFileName = objId.Attachments.Item(j).FileName
            objId.Attachments.Item(j).SaveAsFile SenderNameFolder & "\" & strFileName  '送信者のフォルダにファイルを保存
Next j

先ほども述べましたがAttachementsの中身は以下のようになっています。ファイル名はFileNameで取得できます。

この添付ファイルを所定のフォルダに保存するメソッドはSaveAsFileメソッドです。「添付ファイルのアイテム.SaveAsFile 保存先」で指定することで保存が可能です。

なおSaveAsFileメソッドの場合ファイル名が同じ場合は上書き保存されてしまいます。

私の業務では同名の古いファイルは必要ない為気にしていませんが、気にされる方はDir関数で再度ファイルを検索し、同じファイルが存在する場合は枝番を付けるなどの処理をしてください。

ここでのまとめ

Outlook VBAの代表的なイベントマクロは[Microsoft Outlook Object]の[ThisOutlookSession]に用意されています。

今回はメールを受信した際に起こすイベントとしてApplicationオブジェクトのNewMailExイベントを使用しました。

このイベントで取得したEntryIDをもとにすれば添付ファイルの保存だけでなく自動振り分けなども可能になりますので使用してみてください。