非IT企業に勤める中年サラリーマンのIT日記

非IT企業でしかもITとは全く関係ない部署にいる中年エンジニア。唯一の趣味がプログラミングという”自称”プログラマー。

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

   

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

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

 

今回のプログラムの概要

今回のプログラムは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