決まった件名のメッセージを受信したら、データを CSV ファイルに保存するマクロ


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


メールの受信時に、決まった件名であれば、ある文字列以降の文字列を抽出し、
CSVファイルの最後に追加したいのです。
例えば、このような感じです。
件名 受注メール
商品番号 1234
商品名 ぽーしょん
数量 2
1234,ぽーしょん,2
このようなことができれば、メールから受注データを作成できるので、とても助かります。
よろしくお願いいたします。


メッセージを受信した際に発生する NewMailEx でメッセージの件名を確認し、決められた件名であれば本文からデータを取得するというマクロで対応できるでしょう。
サンプルは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    SaveToCsv EntryIDCollection
End Sub
'
Private Sub SaveToCsv(ByVal EntryIDCollection As String)
    Const AUTO_SAVE_TITLE = "受注メール" ' 自動処理するメールの件名
    Const CSV_FILE = "c:\orders\data.csv" ' データを保存する CSV ファイルの名前
    Dim i As Integer
    Dim arrEntryId
    Dim myMsg
    Dim stmCsv
    Set stmCsv = Nothing
    arrEntryId = Split(EntryIDCollection, ",")
    For i = LBound(arrEntryId) To UBound(arrEntryId)
        Set myMsg = Application.Session.GetItemFromID(arrEntryId(i))
        If myMsg.Subject = AUTO_SAVE_TITLE Then
            Dim strCode
            Dim strName
            Dim strQuantity
            If stmCsv Is Nothing Then
                Dim objFSO
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                Set stmCsv = objFSO.OpenTextFile(CSV_FILE, 8, True, 0)
            End If
            strCode = GetText("商品番号", myMsg.Body)
            strName = GetText("商品名", myMsg.Body)
            strQuantity = GetText("数量", myMsg.Body)
            stmCsv.WriteLine strCode & "," & strName & "," & strQuantity
        End If
    Next
    If Not stmCsv Is Nothing Then
        stmCsv.Close
    End If
End Sub
' 本文からデータを取得する関数
Private Function GetText(strName As String, strBody As String) As String
    Dim ls As Long
    Dim le As Long
    ls = InStr(strBody, strName) ' 指定されたフィールド名を検索
    If ls > 0 Then
        ls = ls + Len(strName) ' フィールド名の次の文字から
        le = InStr(ls, strBody, vbCrLf) ' 改行コードまでを取得
        GetText = Trim(Mid(strBody, ls, le - ls)) ' 前後の空白を削除
    Else
        GetText = ""
    End If
End Function

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

広告

決まった件名のメッセージを受信したら、データを CSV ファイルに保存するマクロ」への23件のフィードバック

  1. 受注データを日付別で保存したいのですが、CSVファイル名もしくは、保存先フォルダ名にタイムスタンプを付けることは出来ますか?また、現在受け取っているメールの本文には、数量のみしか記述されておらず、どこからの発注か見分けるには、送信元アドレスしかありません。そのアドレスも携帯からのため、別CSVファイルで用意されている携帯アドレスと送信者の表とこのマクロ出力のCSVで突合せをしたいのですが、出来ないでしょうか?よろしくお願いいたします。

  2. To haem さんファイル名やフォルダにタイムスタンプをつけることは可能です。Const CSV_FILE = "c:\\orders\\data.csv"をDim CSV_FILE As StringCSV_FILE = "c:\\orders\\data" & format(now,"yyyymmdd") & ".csv"とすれば、ファイル名が "data年月日.csv" というようになります。また、CSV ファイルのレコードに送信元アドレスを追加するには、以下のようにします。stmCsv.WriteLine strCode & "," & strName & "," & strQuantity & "," & myMsg.SenderEmailAddressこのようにして作成した CSV を Excel などで読み込めば突き合わせ処理も可能でしょう。

  3. ありがとうございます。無事にタイムスタンプをつけたCSVファイルに、送信元アドレスを追加して、保存できました。保存したCSVファイルとアドレス一覧のファイルをVLOOKUPで検索することで目的は達成できました。ただ、まだ問題が若干残っていますので、ご教授願います。受注データは、携帯電話から送られてくるため、極力、メール本文には数量のみ記入することで事足りるようにしたいと思っています。とは言っても、あやまって、数量以外の文字が入力されてしまうときもあると思います。このときに、数字だけ(出来れば、全角、半角含めて)を抽出するか、数字以外の文字列があった場合、保存しないといったようなことは、出来ないでしょうか。質問ばかりで申し訳ありませんが、よろしくお願いいたします。

  4. To haemさんもはや Outlook の話と言うより、VB でのプログラミングに関する話になってしまってますね。携帯電話からデータが送られてくるというのは、具体的にどのようなフォーマットなのでしょう?プログラミングで対処可能なものならよいのですが、送信者が本文に好きなようにデータを入力できる状態であれば、プログラムで対応するのは限界があるかもしれません。例えば、「11.0」はどうでしょうか? また、「11,111」 は? 「十個でお願いします」だったら?人間だったらどれでも理解できますが、プログラムの組み方によっては全部 NG になります。それでは「融通が利かない」とクレームにならないでしょうか?ユーザーが自由に入力可能な状態としているのであれば、面倒かもしれませんがプログラムで対処するのではなく、人間が判断すべきだと思います。

  5. 具体的には、決まった件名+本文に数量のみというフォーマットにする予定です。ただ、今までの運用では、Millefeuilleさんが例で出されている通りのようなお願いだったため、フォーマットを突然きちっとしてしまうと、クレームが来そうです。とは言っても、受注側の処理として、店舗数が多くなりすぎてしまったため、現在の運用が耐えられなくなってきています。(ちなみに現在の運用は、送られてきたメールをすべて印刷してから、送信元を確認し、集計しています。)本来論であれば、Webからの発注が出来るようにしたいのですが、今はシステム移行の過渡期で、あと1年ぐらいは現運用を続けなければなりません。その間だけ、少しでも楽に出来ないかと色々と苦慮している状態です。

  6. 疑問・質問・マクロの要望から質問させていただいたNo.59の者です。
    たびたび質問すみません。うまく動いた…気がしたのですが、どうも違ったようでした。

    複数のメールを同時に受信した場合、最後の1件のみデータが抽出され、他はなぜかスルーされてしまいます。
    デバッグしてみると、、
    For i = LBound(arrEntryId) To UBound(arrEntryId)
    の LBound(arrEntryId) と UBound(arrEntryId) がともに0を返していました。

    メールが複数の場合であっても arrEntryId = Split(EntryIDCollection, “,”) が返す配列の要素数は1つなのでしょうか。web上で調べてみると、Outlook2007においてはEntryIDCollectionは「,」区切りの配列を返す、ということだったので大丈夫だと思ったのですが…この状態からどうも理解が進まず、お手上げ状態です。
    (※ちなみにこのページを参照しました→http://msdn.microsoft.com/ja-jp/library/microsoft.office.interop.outlook.applicationevents_11_event.newmailex%28v=office.12%29.aspx
    備考のところでEntryIDsCollectionと複数形になっているのが気になり、一度置き換えてみましたがやはり何も変わりませんでした)

    もしご存知でしたらご教授いただけませんでしょうか。
    どうぞよろしくお願いいたします。

    • 実は、Outlook 2007 では EntryIDCollection に複数の EntryID が格納されなくなりました。
      そのため、本来であれば複数のメールをまとめて受信した場合には受信した数だけ NewMailEx が呼び出されるはずです。
      それが呼び出されないとなると、何かトラブルが発生しているのかもしれません。

      • お礼が遅くなってしまい本当に申し訳ありません!
        【最近のコメント】でお返事があるかどうかをチェックしていたつもりでしたが、今まで気付かずにおりました。非礼をどうかお許しください。
        前回の質問後すぐ、わたしも結局同じ結論に達しました。
        テストではうまく作動しますが、本番ではだめです。送信側はいわゆるショッピングモールなのですが、そのメールの送り方が、特に複数メールの場合、もしかするとNewMailExで対応できないものになっているのかもしれません。原因は特定できませんが・・・。
        現在は、まず仕分けルールで特定フォルダに処理するメールを振り分け、そのフォルダに対して処理を実行できる方法を考えております。
        非常に参考になりました。また記事を参考にさせていただこうと思います。
        ありがとうございました。

  7. こんにちは。
    「決まった件名」ではなく「特定の文字列が含まれる件名」という条件は可能なのでしょうか。

    件名: 受注メール -Aさんより-
    件名: 受注メール -Bさんより-
    件名: 受注メール -Cさんより-

    件名に「受注メール」が含まれるものをCSV書き出し

    宜しくお願い致します。

  8. はじめまして。貴重なサイトをご提供ありがとう御座います。
    初心者でございましてVBAについての知識ほあまりございませんその中で
    こちらの情報を元にデータを作らせていただいています。

    CSVにデータを取りたいのですが蓄積される結果は
    ,,,,,になってしまいます。

    どうか改善策などをご教授いただければと思いかきこませていただきました。

    まず
    【環境】
    OS:windows 7
    OutLook:2010

    共通するメールの件名だけを引っ張っています。

    VbaProject.OTMに
    ****************************************************

    Private Sub SaveToCsv(ByVal EntryIDCollection As String)
    Const AUTO_SAVE_TITLE = “お問い合せフォームから” ‘
    Const AUTO_SAVE_ADDRESS = “ooo@xxx.ne.jp” ‘
    Const CSV_FILE = “C:\mailform\Data.csv”
    Dim i As Integer
    Dim arrEntryId
    Dim myMsg
    Dim stmCsv
    Set stmCsv = Nothing
    arrEntryId = Split(EntryIDCollection, “,”)
    For i = LBound(arrEntryId) To UBound(arrEntryId)
    Set myMsg = Application.Session.GetItemFromID(arrEntryId(i))
    If myMsg.Subject = AUTO_SAVE_TITLE Then
    Dim strUketuke
    Dim strDate1
    Dim strTime1
    If stmCsv Is Nothing Then
    Dim objFSO
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    Set stmCsv = objFSO.OpenTextFile(CSV_FILE, 8, True, 0)
    End If
    strUketuke = GetText(“受付番号”, myMsg.Body)
    strDate1 = GetText(“[ ご予約 第1希望日 ]”, myMsg.Body)
    strTime1 = GetText(“[ 第1希望日時 ご希望時間 ]”, myMsg.Body)
    strDate2 = GetText(“[ ご予約 第2希望日 ]”, myMsg.Body)
    strTime2 = GetText(“[ 第2希望日時 ご希望時間 ]”, myMsg.Body)
    stmCsv.writeline strUketuke & “,” & strDate1 & “,” & strTime1 & “,” & strDate2 & “,” & strTime2
    End If
    Next
    If Not stmCsv Is Nothing Then
    stmCsv.Close
    End If
    End Sub

    Private Function GetText(strName As String, strBody As String) As String
    Dim ls As Long
    Dim le As Long
    ls = InStr(strBody, strName)
    If ls > 0 Then
    ls = ls + Len(strName)
    le = InStr(ls, strBody, vbCrLf)
    GetText = Trim(Mid(strBody, ls, le – ls))
    Else
    GetText = “”
    End If
    End Function
    **********************************************************************************************************

    届くメール本文には
    以下の情報(その他氏名や住所等)

    *******************************
    受付番号:00000001

    [ ご予約 第1希望日 ] 2013/01/22 (火曜日)
    [ 第1希望日時 ご希望時間 ] 8:20
    [ ご予約 第2希望日 ] 2013/01/22 (火曜日)
    [ 第2希望日時 ご希望時間 ] 8:30
    *******************************

    でーたがうまく取れていないのはどのあたりに原因があるのかご教授いただけませんでしょうか。。。
    どうぞよろしくおねがいいたします。

    • 私の手元で確認したところ、このコードで問題なくデータが取れるようです。
      環境に依存する問題のようですね。
      例えば、メッセージ取得の後に MsgBox myMsg.Body といれて本文が正しく表示できますでしょうか?

      • どうも!
        ご検証頂きありがとうございます。

        今、丁度いろいろなページを見ながら勉強させていただいておりました!

        strUketuke = GetText(“受付番号”, myMsg.Body)

        ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

        strUketuke = GetText(“受付番号”, MsgBox myMsg.Body)

        にするとコンパイルエラー:修正候補:区切り記号または)になってしまいます

      • すみません。
        MsgBox myMsg.Body は本文が正しく取得されているかどうかを確認するための記述なので、単独の行で記述します。
        例えば、

        MsgBox myMsg.Body
        strUketuke = GetText(“受付番号”, myMsg.Body)

        というようにしてみてください。

  9. 横から失礼します。

    本件に近い操作をしたいと考えています。
    1.一定の文言が含まれるメールが対象
    2.対象としたメール本文から、対象となる文言が含まれる部分(1行)を抜き出し、CSV化

    具体的には
    1.件名:「~を入力しました。」 ※「~」は、都度 異なります。
    2.本文:「●:●● ■■会議 予約済」 →この「予約済」を対象として、その1行を抜き出してCSV化で一覧にしたいと思っています。

    このような操作は可能でしょうか?また、どのように設定すれば良いでしょうか?
    ご教示、お願い致します。
    ※初心者につき、説明がわかりにくいようでしたら すみません。

  10. はじめまして。Outlook VBAについて詳しく書かれていて非常に助かっております。
    こちらの記事のサンプルプログラムを改良して業務で活用しようと考えているのですが、
    色々と検証したところBodyが取得できていない様なので取得方法をご教授ください。
    環境はWindows10でOutlook2010を利用しています。
    検証としては、Private Funvtion GetTextで常にlsが0である事と、
    Private Sub SaveToCsv内のIf myMsg.Subject~をmyMsg.Bodyにして、
    Body内部にAUTO_SAVE_TITLEの内容を記述しても処理が進まないことや、
    stmCsv.WriteLine でmyMsg.Body & “,” & myMsg.Subjectと記述した時にSubjectしか
    csvファイルに書き込まれない事から上記の様に考えました。

    私としてはお手上げに近い状態で非常に困っております…。

    • そのほかにもmyMsg.ReceivedTimeをcsvに吐き出すように記述しても問題なく動作することを確認しました。文字コードの問題でしょうか…?

      • コメント欄を汚してしまい、申し訳ございません。どうやらIMAP4による問題のようでした。
        『メッセージを受信したら自動返信し、メール本文と添付ファイルを印刷するマクロ IMAP4 対応版 』の記事を参考に、上記プログラムと組み合わせることで目的の動作を実現できました。

  11. 度々申し訳ございません。メールの本文を1行毎に処理するというのは可能でしょうか。

    メール本文が何行あるかは定まってなく、
    任意の文字列1
    任意の文字列2
    任意の文字列3

    といった内容のメールが来た時、
    任意の文字列1がXXで終わってたらXXの前N文字を取得してCSVに書き出し、
    無ければ任意の文字列1を全てCSVに書き出すという処理を、
    メール本文終わりまで行いたいです。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中