受信トレイのすべてのメッセージを MSG ファイルとして保存するマクロ


メッセージで以下のようなご要望をいただきました。


Outlook の受信トレイにあるすべてのメッセージを “受信日時_件名.msg” というような名前で一括保存したいのですが、そのようなことは可能でしょうか?


以下のようなマクロで可能です。

' ここをトリプルクリックでマクロ全体を選択できます。
'
'
Sub SaveCurrentFolderToDisk()
    On Error Resume Next
    Const SAVE_PATH = "c:\temp\"
    ' 保存するフォルダのパス。最後に必ず \ をつける
    Dim objItem 'As MailItem
    Dim strFileName As String
    Dim i As Integer
    Dim arrErrChars
    Dim objFSO
    arrErrChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' 現在表示中のフォルダすべてについて
    For Each objItem In ActiveExplorer.CurrentFolder.Items
        ' ファイル名を受信日時と件名から作成
        strFileName = Format(objItem.ReceivedTime, "yyyymmdd_hhnn_") & objItem.Subject
        If Err.Number <> 0 Then
            ' エラーが発生したら受信日時ではなく最終更新日時とする
            strFileName = Format(objItem.LastModificationTime, "yyyymmdd_hhnn_") & 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
    Next
End Sub

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

受信トレイのすべてのメッセージを MSG ファイルとして保存するマクロ」への22件のフィードバック

  1. はじめまして。
    ご紹介して頂いたマクロについて、お願いがあります。

    上記のようにOutlook の受信トレイにあるすべてのメッセージを対象にするのではなく、受信トレイ上で選択した複数のメールのみを”受信日時_件名.msg” というような名前で一括保存したいのですが、如何でしょうか?
    更に、保存するフォルダをその都度問い合わせてくるようにすることは可能でしょうか?

    ご検討をお願いします。

    • To masan さん

      選択したメールのみを保存するという場合、以下のコードを変更します。
      – 変更前
      For Each objItem In ActiveExplorer.CurrentFolder.Items
      – 変更後
      For Each objItem In ActiveExplorer.Selection

      また、フォルダ名を実行時に入力する場合、以下のコードを変更します。
      – 変更前
      Const SAVE_PATH = “c:\temp\” ‘ 保存するフォルダのパス。最後に必ず \ をつける
      – 変更後
      Dim SAVE_PATH As String
      SAVE_PATH = InputBox(“フォルダ パス:”)
      If Right(SAVE_PATH,1) “\” Then SAVE_PATH = SAVE_PATH & “\”

  2. outlooklab 様

    masanです。
    若干修正して、うまく走りました。感謝です。
    ありがとうございました。

  3. […] Outlook2003を使用しているのですが、社内ではメールを一通一通、個別のファイルとしてネットワークドライブに保存する習慣があります。 エクスプローラで保存先フォルダを開き、Outlookからドラッグするのですが、その際のファイル名が「件名.msg」から変更することができず、手動で変更する必要があります。(受信日時_差出人_件名.msgというファイル名で保存したいと考えています) そこで、「受信トレイのすべてのメッセージを MSG ファイルとして保存するマクロ」の、保存ファイル名を変更して「受信日時_差出人_件名.msg」というファイル名でメールを保存するボタンを作成し、使用していますが、表示しているフォルダ内のメールがすべて保存されるため、選択したメールのみを保存するようなマクロの作成をお願いしたいです。 基本的には上記マクロと同様で、保存対象を選択したメールのみに変更したいのですが、当方、マクロの知識が全くなく(エクセルでマクロの記録をしたことがある程度)、変更方法がわからず悩んでいます。 作成したいマクロの条件としては、以下のようなものです。 1)選択したメールのみを保存する 2)複数選択の場合は選択したメールがすべて保存される 3)保存先はマクロ内にパスを指定する形で(上記マクロと同様) 4)マクロの変更でmsg形式とrtf形式両方が(排他で)指定できる […]

  4. 選択したメッセージをmsgではなくtxtで保存してくれるフリーソフトは無いものか、と長い間探しましたが見つかりませんでした。
    海外のサイトで希望に近いものはありましたが有償で多機能すぎて採用には至りませんでした。
    こちらのマクロを少し手を加えると実現する事が出来ました。
    とてもシンプルで扱いやすいです。

    ありがとうございました。

  5. ファイル名に差出人を入れるにはどのコードを変更したらよいでしょうか。
    いろいろと試してみたのですが、うまくいきませんでした。

    • 下記の一文を「’ ファイル名として不適切な文字を _ に置き換える」の直前に追加してください。

      strFileName = strFileName & ” ” & objItem.SenderName

  6. 受信フォルダの保存にこのマクロを使って助かっています。
    そこで、今度はこのマクロを転用して送信フォルダの選択したメールを保存しようとしています。
    保存ファイル名として、”to_送信先”(送信先は先頭の一名のみでよい)を入れるとするとどうすればよいのでしょうか?
    全然まとはずれかもしれないのですが、下記のようにいろいろと試したのですが、うまくいきませんでした。
    strFileName = strFileName & “to_” & objMail.Recipients.Item(1)
    ご教授いただけるとありがたいです。

    • strFileName = Format(objItem.ReceivedTime, “yyyymmdd_hhnn_”) & objItem.Subject

      strFileName = Format(objItem.ReceivedTime, “yyyymmdd_hhnn_to_”) & objItem.Recipients.Item(1) & “_” & objItem.Subject

      としたらどうでしょうか?

  7. はじめまして。
    全くの初心者です。
    Outlook2010しかない(ThunderbirdやExpressがない)環境下で、数千件あるeml形式のメールデータを、Outlookで日時順に並べて確認する必要性から、掲載のマクロを使わせていただき、すべてmsg形式に変換することが出来ました。
    これをOutlookに入れ直せば、順序良く表示されるかとおもったのですが、eml形式でOutlookにいれた時と同様、Unknownとなってしまいました。
    原因自体私ではわかりかねるのですが、一括保存の際、Unicode形式になるようマクロを組めばいいのかと思い、もしそのやり方をご教示いただければと思い、コメントさせていただきました。
    よろしくお願いいたします。
    また、もし別の解決策をご存知でしたら、教えていただければと存じます。

  8. こちらのマクロを使わせて頂きました。
    ありがとうございます。

    先方からのメールの件名にTabや制御文字が入っているとフォルダに
    書き出すことが出来ないメールがあったため、不適切な文字の指定箇所に
    追加したところ、無事全てのメールを書き出す事が出来ました。

    ちなみに、こちらでは以下のように修正いたしました。

     arrErrChars = Array(“\”, “/”, “:”, “*”, “?”, “”””, “”, “|”, vbTab, vbCrLf, vbCr, vbLf)

  9. こちらのマクロを利用させていただいています。
    受信以外のフォルダのメールを、フォルダ階層ごと、msg形式で保存することは可能でしょうか。
    たとえば

    ■受信トレイ
    ■作業一覧
    ├|>■今日やること
    ├|>■明日やること
    └|>■来週やること

    というような、フォルダ構成になっているとして、「作業一覧」フォルダ配下のフォルダを含めて
    保存してあるメールを、すべてmsg形式でハードディスクに保存したいのです。

    この様なことは可能でしょうか。ご存じでしたらご教授ください。

    以上です。

  10. outlooklab様
    連絡が遅くなりまして大変申し訳なく思います。
    # 体調を崩してしまい、約2カ月間ほど入院しておりました。

    マクロを作成頂きましてありがとうございました。早速活用させて頂きます。

  11. GMAXから乗換えて苦しんでいます。

    毎日、受信フォルダと送信フォルダのメールを
    cドライブにMSG形式で保存したい、
    かつ、過去に保存したものは保存する必要が無いので
    新規で受送信したもののみを自動で保存することは可能でしょうか?

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中