決まった件名で終わるメッセージを受信したら、キーワードを含む 1 行を CSV ファイルに保存するマクロ


決まった件名のメッセージを受信したら、データを CSV ファイルに保存するマクロのコメントにて以下のご要望をいただきました。


横から失礼します。
本件に近い操作をしたいと考えています。
1.一定の文言が含まれるメールが対象
2.対象としたメール本文から、対象となる文言が含まれる部分(1行)を抜き出し、CSV化
具体的には
1.件名:「~を入力しました。」 ※「~」は、都度 異なります。
2.本文:「●:●● ■■会議 予約済」 →この「予約済」を対象として、その1行を抜き出してCSV化で一覧にしたいと思っています。
このような操作は可能でしょうか?また、どのように設定すれば良いでしょうか?
ご教示、お願い致します。
※初心者につき、説明がわかりにくいようでしたら すみません。

12で質問させていただいた内容に追記させてください。
受信時間と件名もCSVに記載したいです。
まとめると・・・
1.件名の「~を入力しました」をKeyにして
2.件名(フル)と受信時間+本文の一部(●:●● ■■会議 予約済 ←「予約済」をKeyに1行を抜き出す)をCSV化
したいです。
ご教示、よろしくお願いします。


変更点は以下の 2 になります。

  • 件名の先頭部分は可変
  • キーワードを含む 1 行を抽出

件名の一部が一致するという条件を指定する場合は LIKE という演算子を使用します。
例えば、「~を入力しました。」の「~」が可変なのであれば、以下のような条件定義になります。
    If myMsg.Subject Like "*を入力しました。"  Then

また、1 行を抜き出すというのは、言い換えると「キーワードの前後の改行を検索し、その間の文字列を取得する」ということになります。

まとめると、以下のようなマクロで実現できます。

' ここをトリプルクリックでマクロ全体を選択できます。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    SaveLineToCsv EntryIDCollection
End Sub
'
Private Sub SaveLineToCsv(ByVal EntryIDCollection As String)
    Const AUTO_SAVE_TITLE_SUFFIX = "を入力しました。" ' 自動処理するメールの件名の終わりの文字
    Const CSV_FILE = "c:\temp\data.csv" ' データを保存する CSV ファイルの名前
    Const SEARCH_KEY = "予約済み" ' 本文で検索するキーワード
    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 Like "*" & AUTO_SAVE_TITLE_SUFFIX Then
            Dim s As Integer
            Dim e As Integer
            Dim strLine As String
            If stmCsv Is Nothing Then
                Dim objFSO
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                Set stmCsv = objFSO.OpenTextFile(CSV_FILE, 8, True, 0)
            End If
            ' キーワードを本文から検索
            e = InStr(myMsg.Body, SEARCY_KEY)
            If e > 0 Then ' キーワードを含む場合だけ処理
                ' キーワードを含む行の最初 (=直前の行の改行) を検索
                s = InStrRev(myMsg.Body, vbLf, e)
                If s = 0 Then
                    s = 1 ' 改行がなければ本文の先頭から
                End If
                e = InStr(e, myMsg.Body, vbCr)
                'キーワードを含む行の終わりを取得
                If e = 0 Then
                    e = Len(myMsg.Body)
                End If
                ' キーワードを含む行を取得
                strLine = Mid(myMsg.Body, s, e - s)
                strLine = Replace(strLine, vbCr, "")
                strLine = Replace(strLine, vbLf, "")
                stmCsv.WriteLine myMsg.Subject & "," & myMsg.ReceivedTime & "," & strLine
            End If
        End If
    Next
    If Not stmCsv Is Nothing Then
        stmCsv.Close
    End If
End Sub

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

広告

決まった件名で終わるメッセージを受信したら、キーワードを含む 1 行を CSV ファイルに保存するマクロ」への2件のフィードバック

  1. 参考になりました。

    本項目の内容について1点教えてください。

    対象のメールが数件送られてくる場合、
    1件目は結果が想像つきますが、
    2件目以降はどのようになりますでしょうか?
    つまりすでに指定したファイル名のCSVがあるときです。

    ・上書き?
    ・書き込み禁止(1件目のみ保存)?
    ・同じファイルに行を変えて書き出し?

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中