Word 変更履歴を出力するマクロ

Sub ExportRevisionsToExcel()
    Dim wdDoc As Object
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim rev As Object
    Dim i As Integer
    
    ' WordとExcelを開く
    Set wdDoc = ActiveDocument
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Sheets(1)
    
    ' ヘッダーを設定
    xlSheet.cells(1, 1).Value = "インデックス"
    xlSheet.cells(1, 2).Value = "開始位置"
    xlSheet.cells(1, 3).Value = "変更タイプ"
    xlSheet.cells(1, 4).Value = "変更内容"
    
    ' 変更履歴をExcelに転送
    i = 2
    For Each rev In wdDoc.Revisions
        xlSheet.cells(i, 1).Value = rev.Index
        xlSheet.cells(i, 2).Value = rev.Range.Start
        xlSheet.cells(i, 3).Value = rev.Type
        xlSheet.cells(i, 4).Value = rev.Range.Text
        i = i + 1
    Next rev
    
    ' Excelを保存
    xlBook.SaveAs "C:\Users\Public\Documents\Revisions.xlsx"
    xlBook.Close
    xlApp.Quit
    
    ' オブジェクトの解放
    Set wdDoc = Nothing
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
End Sub