导出批注工具--用VBA脚本导出Word评审文档的所有批注

前述介绍了用VBA导出Excel批注，现在介绍用VBA导出Word批注

本文实现的是，通过单击VBA按钮，选择一个word批注文件，即可导出该word所有批注，该批注生成excel文件的格式如下：

页码      行号       批注选中的原文字       批注内容         批注作者
下面是代码实现：

Sub exportWordComments_Click()
    
    'Dim Cmt As Comment
    Dim excelApp As Object
    Dim xlsWbk, objWdApp As Object
    Dim commentsArray
    Dim rows, temp, i As Integer
    Dim filename As String
    'Dim myWDoc As Word.Document
    
    '获取选择中文件的名字
    filename = Application.GetOpenFilename
    If filename = "False" Then
        Exit Sub
    End If
        
    Set objWdApp = CreateObject("word.application")
    objWdApp.Visible = True '启动word应用程序
    Set myWDoc = objWdApp.Documents.Open(filename)
    
    rows = ActiveDocument.Comments.Count
    ReDim commentsArray(1 To rows, 1 To 5)
    
    For i = 1 To rows
        temp = temp + 1
        '页码
        commentsArray(temp, 1) = ActiveDocument.Comments(i).Scope.Information(wdActiveEndPageNumber)
        '行号
        commentsArray(temp, 2) = ActiveDocument.Comments(i).Scope.Information(wdFirstCharacterLineNumber)
        '批注引用内容
        commentsArray(temp, 3) = ActiveDocument.Comments(i).Scope
        '批注内容
        commentsArray(temp, 4) = ActiveDocument.Comments(i).Range
          '作者
        commentsArray(temp, 5) = ActiveDocument.Comments(i).Author
        
    Next
    
    Set excelApp = CreateObject("Excel.Application")
    '打开批注表
    Set xlsWbk = excelApp.Workbooks.Add
    With xlsWbk.Sheets(1)
        .Cells.Clear
        .Range("A2").Resize(rows, 5) = commentsArray
        .Range("A1") = "页码"
        .Range("B1") = "行号"
        .Range("C1") = "批注选中的原文字"
        .Range("D1") = "批注内容"
        .Range("E1") = "批注作者"
        .Columns.AutoFit
    End With
    xlsWbk.SaveAs ActiveDocument.Path & Application.PathSeparator & "修订表.xlsx"
    xlsWbk.Close
    excelApp.Application.Quit
End Sub