特定のドメインの差出人からのメールを受信した際に、その情報をドメイン毎の Excel シートに書き出すマクロ


コメントにて以下のご要望をいただきました。


Outlook2016を利用しています。
メールを受信した際、予め指定した複数のドメイン(outlook.jpなど)からのメールであれば、予め指定したエクセルファイルに、送信者のメールアドレスを書き出すマクロが作成可能でしょうか。
書き出し時は、
・ドメイン毎にシート分け
・名前表示(あれば)とメールアドレス、受信日時を別列に出力
・同一のアドレスがあれば、受信日時のみ更新、新規受信のときは追加
のようにしたく、よろしくお願いいたします。


送信者のメールアドレスは MailItem オブジェクトの SenderEmailAddress で取得できます。
複数のドメインについてチェックするにはドメインの文字列を格納した配列を用意し、その配列のそれぞれの要素について For Each で処理します。
配列をあらかじめ設定する方法としては Array 関数を使う方法と Split 関数を使う方法がありますが、今回は Split 関数を使ってみました。

' ここをトリプルクリックでマクロ全体を選択できます。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objMail
    ' 受信アイテムを取得
    Set objMail = Session.GetItemFromID(EntryIDCollection)
    ' 受信アイテムがメールの場合のみ処理
    If objMail.MessageClass = "IPM.Note" Then
        SaveReportPerDomains objMail
    End If
End Sub
'
Private Sub SaveReportPerDomains(ByVal objMail As MailItem)
    ' ドメイン名を ; で区切って指定
    Const DOMAIN_LIST = "outlook.jp;outlook.com;hotmail.com"
    Dim arrDomains As Variant
    Dim strDomain As Variant
    ' ドメイン配列を生成
    arrDomains = Split(DOMAIN_LIST, ";")
    ' 差出人アドレスのドメインのチェック
    For Each strDomain In arrDomains
        If objMail.SenderEmailAddress Like "*@" & strDomain Then
            ' ドメインが一致したら保存処理
            SaveReportForOneDomain objMail, strDomain
        End If
    Next
End Sub
'
Private Sub SaveReportForOneDomain(objMail As MailItem, ByVal strDomain As String)
    On Error Resume Next
    ' Excel ファイルを開く
    Const EXCEL_FILE = "c:\temp\SenderReport.xlsx"
    '
    Dim objBook
    Dim objSheet
    Dim r As Integer
    ' Excel ファイルを開く
    Set objBook = GetObject(EXCEL_FILE)
    objBook.Windows(1).Activate
    ' ドメインと同じ名前のシートを選択
    Set objSheet = objBook.sheets(strDomain)
    If Not objSheet Is Nothing Then
        ' 1 行目はタイトルとして使用し、2 行目からデータ
        r = 2
        ' 同じアドレスまたはデータがない行まで移動
        While objSheet.Cells(r, 1) <> "" _
            And objSheet.Cells(r, 1) <> objMail.SenderEmailAddress
            r = r + 1
        Wend
        ' シートにメールの情報を追記
        With objSheet
            .Cells(r, 1) = objMail.SenderEmailAddress
            .Cells(r, 2) = objMail.SenderName
            .Cells(r, 3) = objMail.ReceivedTime
        End With
    End If
    ' Excel ファイルを閉じる
    objBook.Close True
End Sub

マクロの登録方法やメニューへの追加について

特定のドメインの差出人からのメールを受信した際に、その情報をドメイン毎の Excel シートに書き出すマクロ」への3件のフィードバック

  1. ありがとうございます。
    活用させていただきます。
    不明点ありましたら、また投稿させていただきます。

  2. Exchange 環境なので、別記事を参考にNewMailEx イベント起動から、自動仕分けのルールのアクションへ変更し活用中です。
    その後、以下の機能をExcel出力に追加したいと考えましたが、実力不足で上手くいきません。
    どのようにすればよいかご教示いただけたら幸いです。

    利用の前提としては、自動仕分けのルールのアクションから受信期間指定で実行する方法で考えています。
    つまり、受信毎でなく実行毎の集計(Excel出力)で考えています。

    1) メールアドレス毎、メールの受信回数を記録したい。
    2) 受信回数と合わせ、html形式メール、テキスト形式メール、1)の内訳回数を記録したい。
    3) 外部アドレスだけでなく、社内アドレスでも集計したい。
      →Exchange 環境なので、LegacyExchangeDN準拠(?)なのか本マクロでは集計対象になりません。
      当初は、外部アドレス対象としており問題なかったのですが、2)の機能を社内アドレスでも
      集計したく、どうすればよいかご教示いただければ幸いです。
      社内アドレスも表記では、エイリアス部分にはemailアドレスが存在します。  
      例)
     日本太郎 / NIHON,TARO

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

Google アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中