Word VBA按页拆分文档

Sub 按页拆分文档()

    '本段代码作用: 选择拆分后要保存的文件夹'
    Dim dia As FileDialog
    Set dia = Application.FileDialog(msoFileDialogFolderPicker)
    dia.Title = "请选择拆分后要保存的文件夹"
    If Word.ActiveDocument.Saved Then dia.InitialFileName = Word.ActiveDocument.path
    If dia.Show = 0 Then Exit Sub
    Dim sPath As String
    sPath = dia.SelectedItems(1)
    
    Dim oDoc As Document
    Dim oRng As Range
    Dim oDocTemp As Document
    Set oDoc = Word.ActiveDocument
    
    Dim iPageNo As Long
    '获取总页数
    With oDoc
    iPageNo = .Range.Information(wdNumberOfPagesInDocument)
        For i = 1 To iPageNo
            '定位到页开始
            Set oRng = .GoTo(wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
            oRng.Select
            '定位整个页面区域
            oRng.SetRange oRng.Start, oRng.Bookmarks("\page").End
            oRng.Copy
            '新建文档粘贴、保存、关闭'
            Set oDocTemp = Word.Documents.Add
            With oDocTemp.Application.Selection
                .Paste
            End With
            oDocTemp.SaveAs2 sPath & "\" & oDoc.Name & "_" & i & ".docx"
            oDocTemp.Close
        Next i
    End With
End Sub