フォルダー内のすべてのメールの内容を Excel ファイルに書き出し、さらに MSG ファイルとして保存するマクロ


メールの内容を Excel ファイルにかき出すマクロのコメントにて以下のようなご要望をいただきました。


質問なのですが指定フォルダ(下書きフォルダ)にあるすべてのメールを上記のようにデータ化はできないのでしょうか?
いろいろやってみましたがわかりません可能であればデータ取得後にmgsファイルをファイルネームの頭に連番を付けたうえでcドライブ下のフォルダに入れたいです
よろしくお願いします


もちろん、フォルダーのアイテムをすべて取得するようにすることも可能です。
以下は、現在開いているフォルダーにあるすべてのメールの情報を Excel ファイルに書き出し、さらに c:\temp に msg ファイルとして保存するマクロです。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ExportToExcelAndMSG()
    Const EXCEL_FILE = "c:\temp\リスト.xlsx"
    Const MSG_FILE_BASE = "c:\temp\メール No."
    Dim fldCurrent As Folder
    Dim objItem As MailItem
    Dim objBook 'As Excel.Workbook
    Dim objSheet 'As Excel.Worksheet
    Dim r As Integer
    Dim c As Integer
    ' 現在開いているフォルダーを取得
    Set fldCurrent = ActiveExplorer.CurrentFolder
    ' Excel ファイルを開く
    Set objBook = GetObject(EXCEL_FILE)
    objBook.Windows(1).Activate
    Set objSheet = objBook.Sheets(1)
    ' データがない行まで移動
    r = 2
    While objSheet.Cells(r, 1) <> ""
        r = r + 1
    Wend
    c = 1
    ' メールの情報を Excel ファイルに追記
    For Each objItem In fldCurrent.Items
        With objSheet
            .Cells(r, 1) = objItem.To
            .Cells(r, 2) = objItem.CC
            .Cells(r, 3) = objItem.Subject
            .Cells(r, 4) = objItem.Body
            .Cells(r, 5) = objItem.SenderName
        End With
        objItem.SaveAs MSG_FILE_BASE & c & ".msg", olMSGUnicode
        r = r + 1
        c = c + 1
    Next
    ' Excel ファイルを閉じる
    objBook.Close True
    MsgBox fldCurrent.Name & "のアイテムを保存しました。"
End Sub

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

フォルダー内のすべてのメールの内容を Excel ファイルに書き出し、さらに MSG ファイルとして保存するマクロ」への2件のフィードバック

  1. まったくのマクロ初心者ですが、こちらのサイトを拝見しながらなんとか取り組んでいるところです。いつもありがとうございます。

    さて、上記の「フォルダー内のすべてのメールの内容をExcelファイルに書き出し、さらにMSGファイルとして保存するマクロ」についてなのですが、保存はされるのですが、昇順(日時)にどうしてもなりません。昇順になるように指示することはできますか。

    Excelに書き出される順番にMSGファイルも書き出されており、順不同のような感じです。エクスポート時にOutlookでは昇順になっていることを確認しています。また、メッセージではなく、「予定表」などが混じっているせいかと思い、削除して試してみましたが同じでした。

    どうも見当違いなところを見ている気がするのですが、アドバイスいただけると大変助かります。

    • For Each objItem In fldCurrent.Items

      Set colItems = fldCurrent.Items
      colItems.Sort “受信日時”
      For Each objItem in colItems

      としてみてください。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中