导出批注工具--用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