Word文档拆分VBA代码问题：提取文档数量不符预期

待处理文档为“WHITGL0T1.docx”（共47页），目标是每当找到短语“Ntra Ref”时，将对应页面范围提取为单独PDF文档。但运行以下VBA代码后，全部47页被拆分为单页文档，而文档中“Ntra Ref”仅出现44次，预期应生成44个文档。

原代码：

Sub SplitDocument()
    Dim SourcePath As String
    Dim DestinationPath As String
    Dim SourceDoc As Document
    Dim i As Integer
    Dim isDocumentStart As Boolean
    Dim docNumber As Integer
    Dim startPage As Integer
    Dim endPage As Integer

    SourcePath = "C:\Users\u1285829\OneDrive - MMC\Desktop\Spain\Eurosys PDF\"
    DestinationPath = "C:\Users\u1285829\OneDrive - MMC\Desktop\Spain\Splitted documents\"
    docNumber = 1
    isDocumentStart = False

    Set SourceDoc = Documents.Open(SourcePath & "WHITGL0T1.docx")

    For i = 1 To SourceDoc.ComputeStatistics(wdStatisticPages)
        If SourceDoc.Range.GoTo(wdGoToPage, wdGoToAbsolute, i).Find.Execute(FindText:="Ntra Ref", MatchWholeWord:=True) Then
            If Not isDocumentStart Then
                startPage = i
                isDocumentStart = True
            Else
                endPage = i - 1
                SourceDoc.ExportAsFixedFormat2 OutputFileName:=DestinationPath & "Document_" & docNumber & ".pdf", ExportFormat:=wdExportFormatPDF, Range:=wdExportFromTo, From:=startPage, To:=endPage
                docNumber = docNumber + 1
                startPage = i
            End If
        End If
    Next i

    If isDocumentStart Then
        endPage = SourceDoc.ComputeStatistics(wdStatisticPages)
        SourceDoc.ExportAsFixedFormat2 OutputFileName:=DestinationPath & "Document_" & docNumber & ".pdf", ExportFormat:=wdExportFormatPDF, Range:=wdExportFromTo, From:=startPage, To:=endPage
    End If

    SourceDoc.Close SaveChanges:=False

    MsgBox "The document has been split into separate documents based on the 'Ntra Ref' criteria and saved in the destination folder.", vbInformation
End Sub

问题排查分析 #

• 搜索范围错误：原代码中SourceDoc.Range.GoTo(wdGoToPage, wdGoToAbsolute, i)仅返回第i页的起始位置，随后的Find.Execute会从该位置向后搜索整个文档。只要文档中存在"Ntra Ref"，所有页面的判断都会返回True，导致每一页都被当成拆分触发点。
• 循环逻辑异常：因为每一页的If条件都成立，isDocumentStart在第一页就被设为True，后续每一页都会执行Else分支，将上一页作为结束页导出，最终生成47个单页文档。

修复方案 #

1. 限制搜索范围为当前页面 #

需要获取当前页面的完整Range对象，仅在该范围内执行Find操作，确保只判断当前页面是否包含"Ntra Ref"。

2. 优化拆分逻辑 #

记录每个包含"Ntra Ref"的页面，按连续区间拆分（即从第一个"Ntra Ref"页面到下一个"Ntra Ref"页面的前一页，最后一个区间到文档末尾）。

修复后的代码：

Sub SplitDocument_Fixed()
    Dim SourcePath As String
    Dim DestinationPath As String
    Dim SourceDoc As Document
    Dim i As Integer
    Dim isDocumentStart As Boolean
    Dim docNumber As Integer
    Dim startPage As Integer
    Dim endPage As Integer
    Dim pageRange As Range

    SourcePath = "C:\Users\u1285829\OneDrive - MMC\Desktop\Spain\Eurosys PDF\"
    DestinationPath = "C:\Users\u1285829\OneDrive - MMC\Desktop\Spain\Splitted documents\"
    docNumber = 1
    isDocumentStart = False

    Set SourceDoc = Documents.Open(SourcePath & "WHITGL0T1.docx")

    For i = 1 To SourceDoc.ComputeStatistics(wdStatisticPages)
        ' 获取当前页面的完整Range
        Set pageRange = SourceDoc.Range
        pageRange.Start = SourceDoc.GoTo(wdGoToPage, wdGoToAbsolute, i).Start
        If i < SourceDoc.ComputeStatistics(wdStatisticPages) Then
            pageRange.End = SourceDoc.GoTo(wdGoToPage, wdGoToAbsolute, i + 1).Start - 1
        End If

        ' 仅在当前页面范围内搜索
        pageRange.Find.ClearFormatting
        If pageRange.Find.Execute(FindText:="Ntra Ref", MatchWholeWord:=True) Then
            If Not isDocumentStart Then
                startPage = i
                isDocumentStart = True
            Else
                endPage = i - 1
                ' 导出当前区间的PDF
                SourceDoc.ExportAsFixedFormat2 _
                    OutputFileName:=DestinationPath & "Document_" & docNumber & ".pdf", _
                    ExportFormat:=wdExportFormatPDF, _
                    Range:=wdExportFromTo, _
                    From:=startPage, _
                    To:=endPage
                docNumber = docNumber + 1
                startPage = i
            End If
        End If
    Next i

    ' 导出最后一个区间
    If isDocumentStart Then
        endPage = SourceDoc.ComputeStatistics(wdStatisticPages)
        SourceDoc.ExportAsFixedFormat2 _
            OutputFileName:=DestinationPath & "Document_" & docNumber & ".pdf", _
            ExportFormat:=wdExportFormatPDF, _
            Range:=wdExportFromTo, _
            From:=startPage, _
            To:=endPage
    End If

    SourceDoc.Close SaveChanges:=False
    MsgBox "拆分完成，共生成" & docNumber & "个文档，已保存到目标文件夹。", vbInformation
End Sub

额外说明 #

• 若"Ntra Ref"可能出现在页面边界（跨页），可调整pageRange的边界判断逻辑，避免遗漏匹配。
• 建议先在测试文档上验证代码，确认拆分结果符合预期后再处理正式文档。

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