受信したメールを振り分け前にアカウントごとのフォルダーに保存するマクロ


受信したメールを振り分け前に保存するマクロのコメントにて以下のご要望をいただきました。


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


方法の一つとしては、SaveMessage をアカウントごとに作るというものもありますが、アカウント名を取得することも可能ですので、そのようなマクロを作ってみました。
以下がそのマクロです。 ルールで実行するスクリプトとして SaveMessageByAccount を指定します。
なお、アカウント名のフォルダーはあらかじめ作成しておく必要があります。
ルールでの指定方法などについては受信したメールを振り分け前に保存するマクロを参照してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub SaveMessageByAccount(ByRef objItem As MailItem)
    On Error Resume Next
    Const SAVE_PATH = "c:\temp\" ' 保存するフォルダの親パス。最後に必ず \ をつける
    Const dispidInetAcctName = "http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8580001E"
    Dim strFileName As String
    Dim strFolder As String
    Dim i As Integer
    Dim arrErrChars
    Dim objFSO
    arrErrChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    ' アカウント名をフォルダー名として設定
    strFolder = SAVE_PATH & objItem.PropertyAccessor.GetProperty(dispidInetAcctName) & "\"
    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(strFolder & 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

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

広告

受信したメールを振り分け前にアカウントごとのフォルダーに保存するマクロ」への1件のフィードバック

  1. 初めまして。マクロ超初心者です。
    仕事に、プライベートに大変役立たせていただいています。いままでは「受信したメールを振り分け前に保存するマクロ」を使用させていただき大変助かっていましたが、このたび会社のPCが変更(WIN7,office2010からWIN’,office2013に変更)になり、同じように設定しましたがうまく作動しません。エラーメッセージも出ません。ためしにアカウントは1つですが「受信したメールを振り分け前にアカウントごとのフォルダーに保存するマクロ」も試しましたが同じく作動しません。同じくエラーメッセージも出ません。同じスペックの違うPCのOffice2013で試しましたが、同じく作動しません。個人のことですが今大変困っています、お忙しい中お手数ですがご指導のほどよろしくお願いいたします。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中