特定の文字列で始まる件名のメールを受信した際に、その受信日時と本文中のデータを Excel ファイルに保存するマクロ


Outlook マクロ・スクリプト インデックスのコメントにて以下のご要望をいただきました。


はじめまして

Inbox直下のサブフォルダーに特定の形式、同じアドレスから入ってくるオーダーメールが日に150件ほど届きます。
タイトル「特定の文字列+オーダー番号」
  本文
オーダー番号:*****
  顧客名:******
  電話番号:******

このオーダーメールが届く度に随時所定のExcelファイルに受信日時を含めて情報を書き出すマクロを作りたいと思っています。
  受信日時:A列
  顧客名:B列
Customer Name: C列
  電話番号:D列
※上書きではなく空いている行に積みあがっていくように

以下の2つとにたような形式でできるのではないかと思いますが、どうもうまくいきません。

・「特定の文字列を件名に含むメールを受信した際にその送信者アドレスと受信日時をExcelファイルまたはCSVファイルに保存するマクロ
・「決まった件名のメッセージを受信したら、データを CSV ファイルに保存するマクロ

お力添えを頂けましたら幸いです。


ご推察の通り、上記の二つのマクロを組み合わせることで、ご要望の動作をするマクロを作ることができます。
サンプルは以下の通りなのですが、Excel ファイルに書き出す内容としてオーダー番号がなく、顧客名と Customer Name は重複しているように思われたので、オーダー番号を B 列、顧客名を C 列に書き込むようにしました。

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

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     SaveToExcel EntryIDCollection
End Sub
'
Private Sub SaveToExcel(ByVal EntryIDCollection As String)
     Const AUTO_SAVE_TITLE = "特定の文字列" ' 自動処理するメールの件名
     Const AUTO_SAVE_SENDER = "特定の差出人アドレス" ' 自動処理するメールの差出人アドレス
     Const EXCEL_FILE = "c:\orders\data.xlsx" ' データを保存する Excel ファイルの名前
     Dim i As Integer
     Dim arrEntryId
     Dim myMsg
     Dim stmCsv
     Set stmCsv = Nothing
     Set myMsg = Application.Session.GetItemFromID(EntryIDCollection)
     If myMsg.Subject Like AUTO_SAVE_TITLE & "*" And myMsg.SenderEmailAddress = AUTO_SAVE_SENDER Then
         Dim excBook As Object
         Dim excSheet As Object
         Dim iRow As Integer
         Dim strOrderNumber
         Dim strCustomerName
         Dim strTelephone
         ' Excel ファイルを取得
         Set excBook = GetObject(EXCEL_FILE)
         excBook.Windows(1).Activate
         ' 1 つ目のワークシートを取得
         Set excSheet = excBook.Worksheets(1)
         ' あいている行を検索
         iRow = 2
         While excSheet.Cells(iRow, 1) <> ""
             iRow = iRow + 1
         Wend
         ' 本文からデータを取得
         strOrderNumber = GetText("オーダー番号:", myMsg.Body)
         strCustomerName = GetText("顧客名:", myMsg.Body)
         strTelephone = GetText("電話番号:", myMsg.Body)
         ' あいている行に受信日時と取得したデータを書き込み
         excSheet.Cells(iRow, 1) = myMsg.ReceivedTime
         excSheet.Cells(iRow, 2) = strOrderNumber
         excSheet.Cells(iRow, 3) = strCustomerName
         excSheet.Cells(iRow, 4) = strTelephone
         excBook.Save
         excBook.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

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

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中