Word文档按照页码拆分，要求以每页第一行文字为word名称

deep_sky

要求：Word文档按照页码拆分，要求以每页第一行文字为word名称，没有文字页，用页码代替；下面是我的VBA代码，希望大家能帮我改正下；

Function GetPageNumbers() As Integer
Dim myRange, sRange, eRange As Range
Dim i As Integer
i = 1
Set sRange = Selection.GoTo(what:=wdGoToPage, which:=wdGoToFirst)
Do
    Set myRange = sRange
    i = i + 1
    Set eRange = Selection.GoTo(what:=wdGoToPage, which:=wdGoToNext, Name:=Str(i))
    If myRange.Start = eRange.Start Then
        Exit Do
    Else
        Set sRange = eRange
    End If
Loop
GetPageNumbers = i - 1
End Function
Sub SpiltDoc()
Dim i, pn As Integer
Dim sRange, eRange, myRange As Range
Dim pathname, docname As String

pathname = ActiveDocument.Path
docname = ActiveDocument.Name

pn = GetPageNumbers()
For i = pn To 1 Step -1
    Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:=Str(i)
    Selection.EndKey unit:=wdStory, Extend:=wdExtend
    Selection.Cut
    Application.Documents.Add
    Selection.Paste
    ActiveDocument.SaveAs pathname & "\" & Left(docname, Len(docname) - 4) & "-" & Str(i) & ".doc"
    ActiveDocument.Close
Next
End Sub