Outlook VBAで受信メールフォルダ内のメールを抽出してExcelに出力させる方法

Sub ExportEmailsToExcel()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olMailItem As Object
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
    Dim iRow As Integer
    
    ' Outlookアプリケーションを取得
    Set olApp = CreateObject("Outlook.Application")
    ' Outlookの名前空間を取得
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' メールを取得するフォルダを指定（例: 受信トレイ）
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6は受信トレイを表す
    
    ' Excelアプリケーションを起動
    Set xlApp = CreateObject("Excel.Application")
    ' 新しいワークブックを作成
    Set xlWB = xlApp.Workbooks.Add
    ' ワークシートを選択
    Set xlWS = xlWB.Sheets(1)
    
    ' エクセルのヘッダー行を追加
    xlWS.Cells(1, 1).Value = "受信日時"
    xlWS.Cells(1, 2).Value = "送信者"
    xlWS.Cells(1, 3).Value = "件名"
    xlWS.Cells(1, 4).Value = "本文"
    
    ' 行カウンタ
    iRow = 2
    
    ' フォルダ内のメールをループ処理
    For Each olMailItem In olFolder.Items
        If olMailItem.Class = 43 Then ' メールアイテムのクラスは43（olMail）です
            xlWS.Cells(iRow, 1).Value = olMailItem.ReceivedTime
            xlWS.Cells(iRow, 2).Value = olMailItem.SenderName
            xlWS.Cells(iRow, 3).Value = olMailItem.Subject
            xlWS.Cells(iRow, 4).Value = olMailItem.Body
            iRow = iRow + 1
        End If
    Next olMailItem
    
    ' Excelファイルを保存（任意）
    ' xlWB.SaveAs "C:\Path\To\Your\Excel\File.xlsx"
    
    ' メモリを解放してOutlookとExcelを閉じる
    Set olApp = Nothing
    Set xlApp = Nothing
End Sub