受信したメールを振り分け前に保存するマクロ


コメントで以下のようなご要望をいただきました。


受信したメールを残らず、エビデンスとして保存する必要があります
受信フォルダにかかわらず、振分先のフォルダでも、新規に受信したメールを全て
件名.msg
で任意のフォルダ(例えば、c:\temp\)に保存したいです。
また、メールに添付されたファイルも同じ、件名.msgに付加し保存したいです
(イメージ的にはOutlookでメールを選択し、ドラッグ&ドロップを行ったときにできる msgファイルを
自動でつくりたいです)


このようなマクロを実装する一つの方法としては NewMailEx イベントで処理するというものがありますが、こちらのイベントは受信トレイにメールが受信された場合だけ実行され、自動仕分けなどで移動されたメールに対しては実行されません。
そのため、受信したメールを残らず保存するのであれば、ルールからマクロを実行する必要があります。

手順は大きく分けて以下の 2 つです。

  1. メールを保存するマクロを作成する。
  2. メールを受信した際に 1. のマクロを実行するルールを作成する。

以下にそれぞれの詳細を説明します。

1. メール保存するマクロを作成する

まず、ルールで実行される、メールを保存するためのマクロを作成します。マクロは以下の通りです。このマクロでは件名の前に受信日時をつけています。
また、このマクロはルールから実行するためのものであり、マクロのメニューなどから実行することはできません。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub SaveMessage(ByRef objItem As MailItem)
    On Error Resume Next
    Const SAVE_PATH = "c:\temp\" ' 保存するフォルダのパス。最後に必ず \ をつける
    Dim strFileName As String
    Dim i As Integer
    Dim arrErrChars
    Dim objFSO
    arrErrChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' ファイル名を受信日時と件名から作成
    strFileName = Format(objItem.ReceivedTime, "yyyymmdd_hhmm_") & objItem.Subject
    If Err.Number <> 0 Then
        ' エラーが発生したら受信日時ではなく最終更新日時とする
        strFileName = Format(objItem.LastModificationTime, "yyyymmdd_hhmm_") & objItem.Subject
        Err.Clear
    End If
    ' ファイル名として不適切な文字を _ に置き換える
    For i = 0 To UBound(arrErrChars)
        strFileName = Replace(strFileName, arrErrChars(i), "_")
    Next
    ' ファイル名が 260 文字を超えないようにする
    strFileName = Left(SAVE_PATH & strFileName, 250)
    ' 同名のファイルがある場合の処理
    If objFSO.FileExists(strFileName & ".msg") Then
        i = 2
        ' (2) から始める
        While objFSO.FileExists(strFileName & "(" & i & ").msg")
            i = i + 1
        Wend
        strFileName = strFileName & "(" & i & ")"
    End If
    ' ファイルをフォルダに保存
    objItem.SaveAs strFileName & ".msg", olMSG
End Sub

2. メールを受信した際にマクロを実行するルールを作成する

次に、以下の手順で上記のマクロを受信したメールに対して実行するルールを作成します。

  1. [ツール]-[仕分けルールと通知] をクリックします。
  2. [新しい仕分けルール] をクリックします。
  3. [受信メール用に独自の仕分けルールを作成する] を選択し、[次へ] をクリックします。
  4. [次へ] をクリックし、すべての受信メッセージに適用されるというダイアログで [はい] をクリックします。
  5. ステップ 1 の [スクリプトを実行する] をオンにします。
  6. ステップ 2 の [スクリプト] をクリックし、作成したマクロを選択して [OK] をクリックします。
  7. [完了] をクリックし、クライアントルールのダイアログで [OK] をクリックします。
  8. [OK] をクリックします。

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

受信したメールを振り分け前に保存するマクロ」への4件のフィードバック

  1. はじめまして
    日頃からマクロを流用させていただいており大変役立っております。
    本記事「受信したメールを振り分け前に保存するマクロ」について要望があるのですが、
    保存先フォルダ名を固定ではなくアカウント名から取り込んで自動的に変更できないでしょうか?
    例えば、アカウント1で受信した場合はC:\temp\”アカウント1″に、アカウント2で受信した場合は
    C:\temp\”アカウント2”に保存できるようにしたいです。
    よろしくご検討願います。

  2. お世話になります。
    このマクロを40個ほどコピーしてルールと組み合わせて使用していますが、時々保存に失敗するため原因を探っています。
    お気づきの点があればご教授いただきたいです。
    [使い方]
    Outlook2010に40個のアカウントを登録して、受信したメールをメッセージ形式で保存します。保存する際にはアカウント毎に
    フォルダを分けています。
    [変更点]
    マクロはそれぞれ名前と保存先フォルダを変更してThsiOutlookSessionに入れています。
    ルールは各アカウント毎に作成し、
    条件としては、メッセージを受信した時、指定のアカウントを経由した場合、さらにこのコンピュータでメッセージを送受信した場合のみ
    処理は該当するスクリプトを実行
    としています。
    [現象]
    1回の受信で数十個のメールが受信されますが、そのうち数個程度が保存されない事があります。
    メール自体の受信はできているのですが、一部のメールがメッセージとしてファイル保存されません。
    保存されないメールの中には複数の宛先に届いた同じ内容のメールがあり、一方は保存されて
    一方が保存されないといった事も発生しており、メールの内容に起因する現象ではないようです。

    受信とマクロ実行とファイル保存が集中することによる過負荷が原因でしょうか?

    • 原因がよくわからないので、アカウント設定で、送受信グループを複数設けて、ひとつのグループ毎に5アカウントとし、送受信周期を一分ずつずらして負荷を分散してみました。効果のほどはまだわかりません。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中