最後に返信をした日時を CSV ファイルにエクスポートするマクロ


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


outlookの受信トレイからメール返信を行ったものに対して、受信から48時間以内に
返信ができているかを確認し、集計する方法はあるのでしょうか。
返信をするとそのメールには「○月○日○時○分に返信しました」と表示されているのですが、
それが、ただ表示なのかデータとして移動できる項目なのかもわかりません。
Excelに貼り付けたりできれば、集計できるのではないかと考えているのですが、
そもそもそのようなことができるのか、他に良い方法があるのか、outlookの機能に
方法があるのかなどご存知でしたら、お教えいただけませんでしょうか。


Outlook で返信や転送を行った場合、以下のような MAPI プロパティに操作内容と日時が記録されます。

PidTagLastVerbExecuted – 最後に行った特定の操作
PidTagLastVerbExecutionTime – 最後に特定の操作を行った日時

そして、この情報をもとに Outlook は「○月○日○時○分に返信しました」というような情報を表示しています。
したがって、これらのプロパティの内容を CSV として書き出せば、集計は可能と考えられます。

ただし、このプロパティは最後に返信や転送を行った日時を記録するという点に注意が必要です。
例えば、一度全員に返信を行った後、同じメールを転送した場合、返信を行った記録は転送の記録で上書きされ、返信した日時が不明になります。
残念ながら、返信の履歴を追うようなことは困難です。

現在表示しているフォルダーのアイテムについて、返信を行ったメールの件名、受信日時、返信日時を CSV ファイルとしてエクスポートするマクロは以下のようなものになります。

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

Public Sub ExportLastReplyDate()
     On Error Resume Next
     ' MAPI の定数定義
     Const PidTagLastVerbExecuted = "http:" & "//schemas.microsoft.com/mapi/proptag/0x10810003"
     Const PidTagLastVerbExecutionTime = "http:" & "//schemas.microsoft.com/mapi/proptag/0x10820040"
     Const NOTEIVERB_REPLYTOSENDER = 102
     Const NOTEIVERB_REPLYTOALL = 103
     ' エクスポート先の CSV ファイルのパスを指定
     Const CSV_FILE_NAME = "c:\temp\replyreport.csv"
     Dim fldCurrent As Folder
     Dim itmCurrent As Variant
     Dim iVerb As Integer
     Dim dtExec As Date
     ' CSV ファイルを開く
     Open CSV_FILE_NAME For Output As #1
     ' 1 行目を書き出し
     Print #1, "件名,受信日時,返信日時"
     ' 現在表示しているフォルダーを取得
     Set fldCurrent = ActiveExplorer.CurrentFolder
     ' フォルダーのすべてのアイテムを処理
     For Each itmCurrent In fldCurrent.Items
         With itmCurrent.PropertyAccessor
             ' 最後の実行した操作を取得
             iVerb = .GetProperty(PidTagLastVerbExecuted)
             ' 操作が返信の場合
             If iVerb = NOTEIVERB_REPLYTOSENDER _
             Or iVerb = NOTEIVERB_REPLYTOALL Then
                 ' 返信を実行した日時を取得
                 dtExec = .GetProperty(PidTagLastVerbExecutionTime)
                 ' CSV に件名と受信日時、返信を実行した日時を書き出す
                 Print #1, """" & itmCurrent.Subject & """," & _
                     itmCurrent.ReceivedTime & "," & dtExec
             End If
         End With
     Next
     ' ファイルを閉じる
     Close #1
End Sub

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

広告

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中