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


コメントにて以下のご要望をいただきました。


こんにちわ。
  指定のタイトルのメールを受信した場合に、本文の一部をエクセルにコピーするマクロはどのように作成するか、教えていただけないでしょうか。
  例えば
  タイトル
  ・タイトル
本文
・番号:〇〇○
・氏名:△△△
・住所:◻︎◽︎◻︎
・生年月日:××
・依頼内容:☆☆☆
というメールを受け取った際に、番号欄の〇〇○、氏名欄の△△△、依頼内容の☆☆☆のみを指定のエクセルデータに一覧として出力をしたいです。
エクセルの1行目には番号、氏名、依頼内容など項目名は事前にある状態です。
  複数のメールの内容を一つのエクセルに一覧として入力をしたいです。
  以上、よろしくお願いします。


以前、決まった件名のメッセージを受信したら、データを CSV ファイルに保存するマクロとして似たようなマクロを公開していますが、こちらのマクロでテキストファイルに書き出している処理を Excel ファイルへの書き出しに変更することでご要望は実現できます。
マクロは以下のようになります。


' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     SaveToExcel EntryIDCollection
End Sub
'
Private Sub SaveToExcel(ByVal EntryIDCollection As String)
     Const AUTO_SAVE_TITLE = "タイトル" ' 自動処理するメールの件名
     Const EXCEL_FILE = "c:\temp\request.xlsx" ' 保存する Excel ファイルの名前
     Dim i As Integer
     Dim myMsg
     ' メッセージの取得
     Set myMsg = Session.GetItemFromID(EntryIDCollection)
     ' 指定の件名のメールのみ処理を実行
     If myMsg.Subject = AUTO_SAVE_TITLE Then
         Dim objBook
         Dim objSheet
         Dim r As Integer
         Dim strCode
         Dim strName
         Dim strQuantity
         ' Excel ファイルを開く
         Set objBook = GetObject(EXCEL_FILE)
         objBook.windows(1).Activate
         Set objSheet = objBook.sheets(1)
         ' 1 行目はタイトルとして使用し、2 行目からデータ
         r = 2
         ' データがない行まで移動
         While objSheet.Cells(r, 1) <> ""
             r = r + 1
         Wend
         ' 本文から取り出したデータを Excel ファイルに転記
         With objSheet
             .Cells(r, 1) = GetText("番号:", myMsg.Body)
             .Cells(r, 2) = GetText("氏名:", myMsg.Body)
             .Cells(r, 3) = GetText("依頼内容:", myMsg.Body)
         End With
         ' Excel ファイルを閉じる
         objBook.Close True
     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

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

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

  1. 初めまして。
    お伺い致します。
    先方より書式付きメール設定を解除してくださいと言われましたがどのようにしたらよいか調べても分かりませんでした。
    大変単純な質問で申し訳ないのですが、お教えいただけませんでしょうか。ちなみにバージョンは最新バージョンです。

    • 書式付きメールとなると本文形式が HTML またはリッチテキスト形式になっていることを指していると思います。
      [ファイル]-[オプション] で [メール] をクリックし、[次の形式でメッセージを作成する] で [テキスト形式] を選択して [OK] をクリックしてください。

  2. 抽出したいキーワードが以下のように、各項目の1行下に記載されている場合は、
    どのように記述すればよいでしょうか。
    キーワードは改行含めて複数行になることもあります。

    本文
    ・番号
      〇〇○
    ・氏名
      △△△
    ・住所
      ◻︎◽︎◻︎
    ・生年月日
      ××
    ・依頼内容
      ☆☆☆
      ☆☆☆☆☆☆
      ☆☆☆☆☆☆☆☆☆

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中