导出批注工具–用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.QuitEnd Sub

世上并没有用来鼓励工作努力的赏赐，所有的赏赐都只是被用来奖励工作成果的。