Oulook受信メールの内容をExcelファイルに書き出す方法

2021/06/08

前回、Outlook側からExcelファイルを呼び出しセルにデータを入れて保存するところまでを紹介しました。

このブログ経由でOutlookで受信したメールをExcelで管理したいという相談がありました。本文にはある規則に従った定型文があり、それを解析してデータを抽出しExcelに保存していくような機能です。それを実現しようとするためには、まず最初のステップとしてOutlookからExcelファイルへの書き込みする方法を押さえる必要があります。今回はその機能のみをフォーカスして取り上げたいと思います。Outlookマクロの開発環境Outlookマクロ開発するにあたってまずやらなきゃいけないことは、マクロを書く「Visual Basic Editor」を起動する...

今回はもう少し実践的にメール本文からデータを読み取ってExcelファイルに書き溜めるマクロを作ったので紹介します。

1 今回のプログラムの概要
2 ソースコード
3 リボンにボタン設置
4 実行結果

今回のプログラムの概要

今回のプログラムはOutlookで受信したメールが以下のような定形文を解析し、各項目をExcelシートに書き溜めていくものです。中括弧で示した部分は人が書いたものではなく入力フォームから機械的に生成されたものというイメージです。少しでも形が崩れたらこのプログラムは機能しません。

ソースコード

いかがソースコードです。前段でメール本文を取得して行ごと配列化した後に、【】部分をキーワードに解析して各項目を示す変数に格納しています。その後、Excelファイルを起動して末尾行に書き溜めていくようになっています。

Sub メールデータExcel保存()
    Dim myItem As Outlook.Inspector
    Dim objItem As Object
    Dim mailbody, textline, 会社名, 担当者, 郵便番号, 住所, email, tel As String
    Dim i As Long
    
    Set myItem = Application.ActiveInspector
    Set objItem = myItem.CurrentItem
    mailbody = objItem.Body

    textline = Split(mailbody, vbCrLf)
    
    For i = 0 To UBound(textline)
        If InStr(textline(i), "会社名") Then 会社名 = Replace(textline(i), "【会社名】", "")
        If InStr(textline(i), "担当者") Then 担当者 = Replace(textline(i), "【担当者名】", "")
        If InStr(textline(i), "郵便番号") Then 郵便番号 = Replace(textline(i), "【郵便番号】", "")
        If InStr(textline(i), "住所") Then 住所 = Replace(textline(i), "【 ご住所 】", "")
        If InStr(textline(i), "Email") Then email = Replace(textline(i), "【Email】", "")
        If InStr(textline(i), "Tel") Then tel = Replace(textline(i), "【Tel】", "")
    Next i

    Dim fname As String
    Dim ExcelApp, wb, sh As Object
    Dim r As Long

    fname = "C:\Users\...\Book1.xlsx"
    Set ExcelApp = New Excel.Application
    Set wb = ExcelApp.Workbooks.Open(fname)
    Set sh = wb.Sheets("Sheet1")

    r = sh.Range("A1000").End(xlUp).Row + 1

    sh.Cells(r, 1).Value = 会社名
    sh.Cells(r, 2).Value = 担当者
    sh.Cells(r, 3).Value = 郵便番号
    sh.Cells(r, 4).Value = 住所
    sh.Cells(r, 5).Value = email
    sh.Cells(r, 6).Value = tel

    wb.Save
    wb.Close
End Sub

リボンにボタン設置

上記ソースコードをOutlookマクロに書きます（Visual Basic Editorへの書き込みは省略。ここを参照ください）。ここではリボンにマクロ実行ボタンを設置する方法について紹介します。

リボンを右クリックして「リブンのユーザー設定」を選択します。

以下のようなウィンドウが現れます。左側の選択ボックスを「マクロ」にするとマクロ名が現れます。対象のマクロを選択して右側のタブリストへ追加するわけですが、「メッセージ」タブの最後に「新しいグループ」を作ってそこに追加しましょう。ざっくりした説明ですがここにもう少し詳しく書いているのでわからなかった方は参考にしてください。

以下のようにマクロ実行ボタンが設置されました。アイコンや名前を変更できますがここでは省略します。

実行結果

上のマクロ実行ボタンをクリックすると以下のようにExcelファイルにデータが書き込まれます。実行中Excel自体は開きませんがバックグランドで起動して書かれます。

ちなみに、今回はエラー処理が不十分になっていて、途中でエラー発生するとバックグランドでExcelファイルが立ち上がったままになってしまいます。別途エラーをキャッチしたら保存せずにファイルを終了するような処理が必要になりますが、今回は省略しましたので適宜加えてください。

- Excel, Outlook, VBA