Question

如何利用VBA删除Word里的分页符

我用Word里的“邮件功能”批量生成的邮件，再用下面的语句完成了逐页分割，但是分割出来的每一页后面都带了一张空白页，哪位大侠帮忙解决一下，帮忙修改一下我的语句，可以不出空白页！！
Option Explicit
Sub SplitPagesAsDocuments()
Dim oSrcDoc As Document, oNewDoc As Document
Dim strSrcName As String, strNewName As String
Dim oRange As Range
Dim nIndex As Integer
Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set oSrcDoc = ActiveDocument
Set oRange = oSrcDoc.Content
oRange.Collapse wdCollapseStart
oRange.Select
For nIndex = 1 To ActiveDocument.Content.Information
(wdNumberOfPagesInDocument)
oSrcDoc.Bookmarks("\page").Range.Copy
oSrcDoc.Windows(1).Activate
Application.Browser.Target = wdBrowsePage
Application.Browser.Next

strSrcName = oSrcDoc.FullName
strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName),
_
fso.GetBaseName(strSrcName) & "_" & nIndex & "." &
fso.GetExtensionName(strSrcName))
Set oNewDoc = Documents.Add
Selection.Paste
oNewDoc.SaveAs strNewName
oNewDoc.Close False
Next
Set oNewDoc = Nothing
Set oRange = Nothing
Set oSrcDoc = Nothing
Set fso = Nothing
MsgBox "结束！"
End Sub

Answer 1

因为粘贴后多出来的空白页，就是新建的文档时原来的空白页面，只需在保存前发送一个BACKSPACE键就可删除，代码如下：

Option Explicit
Sub SplitPagesAsDocuments()
    Dim oSrcDoc As Document, oNewDoc As Document
    Dim strSrcName As String, strNewName As String
    Dim oRange As Range
    Dim nIndex As Integer
    Dim fso As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")    '定义文件对象变量
    Set oSrcDoc = ActiveDocument    '设定当前文档对象
    Set oRange = oSrcDoc.Content    '设定当前文档内容对象
    oRange.Collapse wdCollapseStart    '将光标移动到文档开头
    oRange.Select    '选定文档内容
    For nIndex = 1 To ActiveDocument.Content.Information(wdNumberOfPagesInDocument)    '循环遍历文档每个页面
        oSrcDoc.Bookmarks("\page").Range.Copy    '复制当前页面内容
        oSrcDoc.Windows(1).Activate    '显示当前文档窗口
        Application.Browser.Target = wdBrowsePage    '跳转显示下一页
        Application.Browser.Next
        
        strSrcName = oSrcDoc.FullName    '获取当前文档名
        strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
                     fso.GetBaseName(strSrcName) & "_" & nIndex & "." & fso.GetExtensionName(strSrcName))    '定义新文档名
        Set oNewDoc = Documents.Add    '新建文档
        Selection.Paste    '将复制的页面粘贴到新文档中
        Selection.TypeBackspace    '发送回退按键，删除多余页面
        oNewDoc.SaveAs strNewName    '用新文档名保存
        oNewDoc.Close False    '关闭新建文档
    Next
    Set oNewDoc = Nothing
    Set oRange = Nothing
    Set oSrcDoc = Nothing
    Set fso = Nothing
    MsgBox "结束！"
End Sub

追问

测试了，还有空白页，却把最后一个字删了

追答

抱歉，看来是考虑不周。

请把第25句（Selection.TypeBackspace）删除，改为以下两句：

        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend    '从光标开始选择到行尾
        Selection.Delete    '删除所选内容

Answer 2

Selection.Paste 后面加一句
Selection.Delete

追问

测试了，把最后一个字删了

追答

最好把文档传上来测试下

追问

不好意思，是个分节符

追答

不明白你的意思