如何修改VBA代码实现Word评论及关联回复的Excel导出？

完全可以修改代码实现评论与回复的关联标识，核心是利用Word对象模型中Comment对象的Replies集合，为每条回复添加对应的父评论标识。以下是修改后的完整代码及关键改动说明：

修改后的VBA代码 #

Sub ExportCommentsWithReplies()
' 注：需引用Microsoft Excel Object Library，通过Word VBE的【工具】|【引用】设置
Dim StrCmt As String, StrTmp As String, i As Long, j As Long, k As Long
Dim xlApp As Object, xlWkBk As Object, parentCmtId As String

' 新增"父评论ID"表头，用于关联回复与原评论
StrCmt = "Page,Line,Author,Date & Time,Comment,Reference Text,父评论ID"
StrCmt = Replace(StrCmt, ",", vbTab)

With ActiveDocument
  ' 遍历所有顶级评论
  For i = 1 To .Comments.Count
    With .Comments(i)
      ' 用评论的Index作为父评论ID（也可使用.ID属性，更唯一）
      parentCmtId = "评论_" & .Index
      ' 写入顶级评论信息，父评论ID为空
      StrCmt = StrCmt & vbCr & .Reference.Information(wdActiveEndAdjustedPageNumber) & vbTab
      StrCmt = StrCmt & .Reference.Information(wdFirstCharacterLineNumber) & vbTab & .Author & vbTab
      StrCmt = StrCmt & .Date & vbTab & Replace(Replace(.Range.Text, vbTab, "<TAB>"), vbCr, "<P>")
      StrCmt = StrCmt & vbTab & Replace(Replace(.Reference.Text, vbTab, "<TAB>"), vbCr, "<P>") & vbTab & ""
      
      ' 遍历当前评论的所有回复
      If .Replies.Count > 0 Then
        For k = 1 To .Replies.Count
          With .Replies(k)
            ' 写入回复信息，父评论ID设为当前顶级评论的标识
            StrCmt = StrCmt & vbCr & .Reference.Information(wdActiveEndAdjustedPageNumber) & vbTab
            StrCmt = StrCmt & .Reference.Information(wdFirstCharacterLineNumber) & vbTab & .Author & vbTab
            StrCmt = StrCmt & .Date & vbTab & Replace(Replace(.Range.Text, vbTab, "<TAB>"), vbCr, "<P>")
            StrCmt = StrCmt & vbTab & Replace(Replace(.Reference.Text, vbTab, "<TAB>"), vbCr, "<P>") & vbTab & parentCmtId
          End With
        Next k
      End If
    End With
  Next i
End With

' 启动或连接Excel应用
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "无法启动Excel。", vbExclamation
    Exit Sub
  End If
End If
On Error GoTo 0

' 将数据写入Excel
With xlApp
  Set xlWkBk = .Workbooks.Add
  With xlWkBk.Worksheets(1)
    For i = 0 To UBound(Split(StrCmt, vbCr))
      StrTmp = Split(StrCmt, vbCr)(i)
      For j = 0 To UBound(Split(StrTmp, vbTab))
        .Cells(i + 1, j + 1).Value = Split(StrTmp, vbTab)(j)
      Next j
    Next i
    .Columns("A:G").AutoFit ' 适配新增列的宽度
  End With
  MsgBox "评论导出完成。", vbOKOnly
  .Visible = True
End With

' 释放对象
Set xlWkBk = Nothing: Set xlApp = Nothing
End Sub

关键改动说明 #

• 新增关联字段：表头加入「父评论ID」，用于标记每条回复所属的原评论
• 处理回复集合：对每个顶级评论，额外遍历其Replies集合，将回复的父评论ID设为对应顶级评论的标识（这里用评论_Index，也可替换为.ID属性，更具唯一性）
• Excel列适配：调整Columns("A:G").AutoFit以适配新增的「父评论ID」列
• 顶级评论标识：顶级评论的「父评论ID」留空，方便区分原评论和回复

内容的提问来源于stack exchange，提问作者Alexander Prescott