VBAでOutlookメール本文の情報をExcelに取り込む方法

https://extan.jp/wp-admin/post.php?post=7442&action=edit

VBAでOutlookメール本文の情報をExcelに取り込みたいときはないでしょうか。

けど、そんな中で悩むことは、

・VBAでOutlookメール本文の情報をExcelに取り込みたいが方法がわからない。
・VBAでOutlookメール本文の情報を書式設定やリンク情報を含む形でExcelに取り込みたいが方法がわからない。

ですよね。

今回はそんなお悩みを解決する

・VBAでOutlookメール本文の情報をExcelに取り込む方法
・VBAでOutlookメール本文の情報をHTML形式でExcelに取り込む方法

についてまとめます!

VBAでOutlookメール本文の情報をExcelに取り込むイメージ

VBAでOutlookメール本文の情報をExcelに取り込むイメージについて説明をします。

まず、Outlook側の受信トレイにあるメールを確認します。

取得したい期間を指定し、Excel側へVBAを実装、マクロを実行すると、

Excel側に受信トレイにあるメール一覧情報が取り込まれます!

さらにリンク情報や書式情報をふくめることができるHTML形式で本文の情報が取得できます。

それでは早速やってみましょう!

Outlookメール本文の情報をExcelに取り込むVBA

本文抽出対象のメールを確認

Outlook側の受信トレイにあるメールの中で本文を取得したいメール本文の内容や受信日などを確認します。

VBAの準備

Outlookメール本文の情報をExcelに取り込むVBAの実装方法について説明をします。

今回のサンプルコードは以下の通りです。

Sub Outlook受信メール本文一覧を取り込む()

    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object
    Dim strStart As Date
    Dim strEnd As Date
    Dim j As Integer
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long

    '取得結果を記述する行番号を指定します。2の場合、2行目のセルから開始されることになります。
    lnContactCount = 2
    
    '抽出期間の開始日と終了日を指定します。
    strStart = Format("2022/7/14", "yyyy/mm/dd") '開始日を指定
    strEnd = Format("2022/7/16", "yyyy/mm/dd")  '終了日を指定
    
    'スピードアップのためスクリーンの更新を無効にします。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    '書き込み先のセルを指定し1行目にタイトルを入力します。
    With wsSheet

        .Cells.ClearContents
        .Cells(1, 1).Value = "To"
        .Cells(1, 2).Value = "CC"
        .Cells(1, 3).Value = "BCC"
        .Cells(1, 4).Value = "ReceivedTime"
        .Cells(1, 5).Value = "Subject"
        .Cells(1, 6).Value = "Body"
        .Cells(1, 7).Value = "SenderName"
        .Cells(1, 8).Value = "SenderEmailAddress"
        .Cells(1, 9).Value = "SentOn"
        .Cells(1, 10).Value = "ReceivedByName"
        .Cells(1, 11).Value = "Importance"
        .Cells(1, 12).Value = "Size"
        .Cells(1, 13).Value = "CreationTime"
        .Cells(1, 14).Value = "LastModificationTime"
        .Cells(1, 15).Value = "ReminderTime"
        .Cells(1, 16).Value = "BodyFormat"
        .Cells(1, 17).Value = "EntryID"
        
        '書式を追加します。
        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
    
    wsSheet.Activate
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    '既定ユーザーの受信トレイを対象にオブジェクトを取得します。
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olConItems = olFolder.Items
    
    'Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込みます。
    Set olConItems = olConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")

    For Each olItem In olConItems

        'アイテムのタイプが"MailItem"だった場合のみ値を取得します。※それ以外のタイプの場合はプロパティの構成が異なるためエラーとなります。
        If TypeName(olItem) = "MailItem" Then
            With olItem
                Cells(lnContactCount, 1).Value = .To
                Cells(lnContactCount, 2).Value = .CC
                Cells(lnContactCount, 3).Value = .BCC
                Cells(lnContactCount, 4).Value = .ReceivedTime
                Cells(lnContactCount, 5).Value = .Subject
                Cells(lnContactCount, 6).Value = .Body
                Cells(lnContactCount, 7).Value = .SenderName
                Cells(lnContactCount, 8).Value = .SenderEmailAddress
                Cells(lnContactCount, 9).Value = .SentOn
                Cells(lnContactCount, 10).Value = .ReceivedByName
                Cells(lnContactCount, 11).Value = .Importance
                Cells(lnContactCount, 12).Value = .Size
                Cells(lnContactCount, 13).Value = .CreationTime
                Cells(lnContactCount, 14).Value = .LastModificationTime
                Cells(lnContactCount, 15).Value = .ReminderTime
                Cells(lnContactCount, 16).Value = .BodyFormat
                Cells(lnContactCount, 17).Value = .EntryID
                
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    'オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    

    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlook受信メールの取り込みが完了しました!", vbInformation
    
End Sub

VBAの設定

VBAの設定箇所は以下の通りです。

抽出期間の開始日と終了日を指定します。

strStart = Format("2022/7/14", "yyyy/mm/dd") '開始日を指定
strEnd = Format("2022/7/16", "yyyy/mm/dd") '終了日を指定

取得結果を記述する行番号を指定します。2の場合、2行目のセルから開始されることになります。

lnContactCount = 2

VBAの実装

「VBAの実装手順」をご参照ください。

VBAの実行

VBAを実行してみましょう。

「Outlook受信メールの取り込みが完了しました!」と表示されたら完了です。

Excelシートを見てみましょう。

はい、受信メール本文がExcelに取り込まれていますね!

VBAの説明

Excelのブックとワークシートのオブジェクトを設定します。

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)

書き込み先のセルを指定し1行目にタイトルを入力します。

With wsSheet
.Cells.ClearContents
.Cells(1, 1).Value = ""To""
.Cells(1, 2).Value = ""CC""
.Cells(1, 3).Value = ""BCC""
.Cells(1, 4).Value = ""ReceivedTime""
.Cells(1, 5).Value = ""Subject""
.Cells(1, 6).Value = ""Body""
.Cells(1, 7).Value = ""SenderName""
.Cells(1, 8).Value = ""SenderEmailAddress""
.Cells(1, 9).Value = ""SentOn""
.Cells(1, 10).Value = ""ReceivedByName""
.Cells(1, 11).Value = ""Importance""
.Cells(1, 12).Value = ""Size""
.Cells(1, 13).Value = ""CreationTime""
.Cells(1, 14).Value = ""LastModificationTime""
.Cells(1, 15).Value = ""ReminderTime""
.Cells(1, 16).Value = ""BodyFormat""
.Cells(1, 17).Value = ""EntryID""
.Cells(1, 18).Value = ""Attachments""

書式を追加します。

With .Range(""A1:Z1"")
.Font.Bold = True
.Font.ColorIndex = 10
.Font.Size = 11
End With

Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(""MAPI"")

既定ユーザーの受信トレイを対象にオブジェクトを取得します。

Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
Set olConItems = olFolder.Items

Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込みます。ReceivedTime(受信日)を基準にしています。

Set olConItems = olConItems.Restrict(""[ReceivedTime] >= '"" & strStart & ""' And [ReceivedTime] <= '"" & strEnd & ""'"")

アイテムのタイプが””MailItem””だった場合のみ値を取得します。※それ以外のタイプの場合はプロパティの構成が異なるためエラーとなります。

<code> If TypeName(olItem) = ""MailItem"" Then
With olItem
Cells(lnContactCount, 1).Value = .To
Cells(lnContactCount, 2).Value = .CC
Cells(lnContactCount, 3).Value = .BCC
Cells(lnContactCount, 4).Value = .ReceivedTime
Cells(lnContactCount, 5).Value = .Subject
Cells(lnContactCount, 6).Value = .Body
Cells(lnContactCount, 7).Value = .SenderName
Cells(lnContactCount, 8).Value = .SenderEmailAddress
Cells(lnContactCount, 9).Value = .SentOn
Cells(lnContactCount, 10).Value = .ReceivedByName
Cells(lnContactCount, 11).Value = .Importance
Cells(lnContactCount, 12).Value = .Size
Cells(lnContactCount, 13).Value = .CreationTime
Cells(lnContactCount, 14).Value = .LastModificationTime
Cells(lnContactCount, 15).Value = .ReminderTime
Cells(lnContactCount, 16).Value = .BodyFormat
Cells(lnContactCount, 17).Value = .EntryID
End With

各プロパティの内容については以下の通りです。

プロパティ名 説明
To To表示名
CC CC表示名
BCC BCC表示名
ReceivedTime 受信日時
Subject 件名
Body 本文
HTMLBody HTML形式の本文
SenderName 送信者名
SenderEmailAddress 送信者メールアドレス
SentOn 送信日時
ReceivedByName 受信者名
Importance 重要度(2:高、0:低、1:中)
Size メールアイテム容量(バイト数)
CreationTime メールが作成された日時
LastModificationTime:メールを更新した日時
ReminderTime:リマインダーの日時
BodyFormat メールの形式の種類(1:テキスト、2:HTML、,3:リッチテキスト)
EntryID EntryID(メールアイテム固有ID)

Outlookメール本文の情報をHTML形式でExcelに取り込むVBA

次にOutlookメール本文の情報をHTML形式でExcelに取り込んでみましょう。

VBAの変更

以下の変更を行います。
■変更前

Cells(lnContactCount, 6).Value = .Body

■変更後

本文のBodyプロパティからHTMLBodyプロパティへ変更します。

Cells(lnContactCount, 6).Value = .HTMLBody
プロパティ名 説明
HTMLBody HTML形式の本文

VBAを実行

Outlookメール本文の情報をHTML形式でExcel側へ出力されているか確認をしてみましょう。

はい、HTML形式で出力されていますね!

VBAの実装手順

Excel VBAからOutlookを操作するための下準備

Excel VBAからOutlookを操作するための下準備をしていきます。

①Excelを起動し、「開発」タブをクリックします。

②VBEの画面が開いたら、メニューから「ツール」>「参照設定」を選択します。

③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。

Excel側へVBAを実装する

Excel側にVBAを実装していきます。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」+「F11」でもOKです。

②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。

③右ペインのウインドウに上記のマクロを入力します。

こちらで実装完了です。

VBAを実行する

VBAを実行する手順となります。
①「開発」タブの「VBA」をクリックし実行したいマクロを選択し、「実行」をクリックします。

②処理がされたことが確認できれば完了です。

さいごに

いかがでしょうか。

今回は、

・VBAでOutlookメール本文の情報をExcelに取り込む方法
・VBAでOutlookメール本文の情報をHTML形式でExcelに取り込む方法

についてまとめました。

また、他にも便利な方法がありますので、よろしければご参照頂ければと思います。



この記事の関連キーワード

こちらの記事の関連キーワード一覧です。クリックするとキーワードに関連する記事一覧が閲覧できます。








2 件のコメント

  • こんにちわ。いつも参考にさせていただいています。
    このページにある「Outlookメール本文の情報をExcelに取り込むVBA」に似たVBAを自作しており、2点アドバイスを頂けますでしょうか。よろしくお願いいたします。

    ★1
    このページのVBAでは、ExcelのThisWorkbookに転記していますが、特定のExcelファイルを開いてそこに転記させたいと思っています。特定のExcelファイルを開くことはできるのですが、すでに開いた状態でVBAを起動させると読み取り専用になってしまいます。そこで、特定のファイルが開いていればそれをアクティベートさせ、開いていなければ新たに開くようにしたいのですが、どう改良したらよいか教えてください。よろしくお願いいたします。


    2Excelがアクティブな状態になっていますが、最後Outlookをアクティブにして終了したいので、outlookに戻る方法を教えてください。

    以下、私が作成したVBA

    Sub メール情報Excel転記()

    Dim objItem As Object
    Set objItem = Application.ActiveInspector.CurrentItem

    Dim objItem_1 As Date
    Dim objItem_2 As String
    Dim objItem_3 As String
    objItem_1 = objItem.ReceivedTime ‘受信日時
    objItem_2 = objItem.SenderName ‘発信者名
    objItem_3 = objItem.Subject ‘件名

    Dim strFilePath As String
    Dim objExcel As Excel.Application
    Dim ExcelWB As Object
    Dim ExcelWS As Object

    strFilePath = “C:\Users\中略\デスクトップ\メールリスト.xlsx” ‘操作対象Excelファイルのフルパスを指定する。
    Set objExcel = New Excel.Application ‘Excelオブジェクトを作成する。

    If ・・・・・・・ then
    ’★1 ここでstrFilePathが開いていれば、それをアクティブにする。開いていなければElseでstrFilePathを開く。
    ・・・・・・・
    Else
    Set ExcelWB = objExcel.Workbooks.Open(strFilePath) ‘Excelブックを開き情報を取得する。
    End if

    Set ExcelWS = ExcelWB.Worksheets(1) ‘Excelシートの情報を取得する。
    objExcel.Visible = True ‘Excelを表示させる

    Dim i As Integer
    i = ExcelWS.Cells(ExcelWS.Rows.Count, 1).End(xlUp).Row + 1 ‘最終行+1行(入力行)を取得する。
    Debug.Print i

    ‘メールアイテムの貼付
    ExcelWS.Cells(i, “A”).Value = objItem_1
    ExcelWS.Cells(i, “B”).Value = objItem_2
    ExcelWS.Cells(i, “C”).Value = objItem_3

    ‘Excelブックを上書き保存
    ExcelWB.Save

    ’★2ここでOutlookに戻りたい。Excelは開いたままでOK。

    End Sub

    • いつもご利用ありがとうございます。

      一つ目のExcelブックが既に開かれているかどうかの判定ですが、Workbooksオブジェクトを使えばできるかと思います。
      以下のようにチェック関数として独立させIF文の条件に設定させるとよいでしょう。後の処理は考えていれてみてください。
      If IsFileOpenck(strFilePath) then …

      Function IsFileOpenck(strFilePath As String) As Boolean
      Dim ExcelWB As Workbook
      Dim ExcelApp As Object

      ‘GetObjectパス無版でExcelアプリケーションを取得
      Set ExcelApp = GetObject(, “Excel.Application”)

      ‘既に開かれているブックを検索
      For Each ExcelWB In ExcelApp.Workbooks
      If ExcelWB.FullName = strFilePath Then
      ‘既に開かれている場合
      IsFileOpenck = True
      Exit For
      Else
      ‘開かれていない場合
      IsFileOpenck = False
      End If
      Next
      End Function

      2点目のOutlookに戻る方法については以下でいけるかと思います。
      objItem.Display

      よろしくお願いいたします。

  • コメントを残す

    メールアドレスが公開されることはありません。 * が付いている欄は必須項目です