Word でページ毎にファイル分割する VBA

簡単に書けるだろうと思ったら異様なほど手間取った。

Option Explicit

Private Sub PageSplitButton_Click()
    Dim pageCount As Integer: pageCount = Selection.Information(WdInformation.wdNumberOfPagesInDocument)
    Dim saveCount As Integer: saveCount = 0
    Dim i As Integer
    
    Dim targetDocument As Document: Set targetDocument = ActiveDocument
    MsgBox targetDocument.Name & "を処理します(" & pageCount & "ページ)"
    Dim originalViewType As Long: originalViewType = targetDocument.ActiveWindow.View.Type
    targetDocument.ActiveWindow.View.Type = wdNormalView
    
    For i = 1 To pageCount Step 1
        Dim topOfPage As Range: Set topOfPage = targetDocument.GoTo(WdGoToItem.wdGoToPage, , i)
        Dim endOfPage As Range: Set endOfPage = targetDocument.GoTo(WdGoToItem.wdGoToPage, , (i + 1))
        Dim topPos As Long: topPos = topOfPage.Start
        Dim endPos As Long: endPos = endOfPage.Start - 1
        
        If (i >= pageCount) Then
            endPos = targetDocument.Content.End - 1
        End If
        
        Dim length As Long: length = endPos - topPos
        If (length > 0) Then
            ' MsgBox targetDocument.Name & "のページ" & i & "を処理"
            Dim pageRange As Range: Set pageRange = targetDocument.Range(topPos, endPos)
            Dim newDocument As Document: Set newDocument = Documents.Add()
            newDocument.Select
            pageRange.Copy
            Selection.Paste
            
            Dim newDocumentPath As String: newDocumentPath = targetDocument.Path
            Dim newDocumentName As String: newDocumentName = targetDocument.Name & "_splitted_" & i & "_of_" & pageCount & ".doc"
            Call newDocument.SaveAs(targetDocument.Path & "\" & newDocumentName)
            newDocument.Close
            saveCount = saveCount + 1
        End If
        
    Next
    
    targetDocument.ActiveWindow.View.Type = originalViewType
    DoEvents
    MsgBox targetDocument.Name & "を処理しました(" & saveCount & "/" & pageCount & "ページ)"
    Me.Hide
End Sub