VBA Word - Split Word Document of Large size and Many Pages

The following VBA code splits word document into two equal parts.

Sub SplitWordDocumentWithoutOpening()
    Dim appWord As Object
    Dim doc As Object
    Dim newDoc As Object
    Dim totalPages As Long
    Dim startPage As Long
    Dim splitPoint As Long
    Dim rng As Object
    Dim strDocumentPath As String
    Dim strOutputPath As String
    
    strDocumentPath = "G:\Word Documents\1\a1234.docx"
    strOutputPath = "G:\Word Documents"
    ' Create a Word application object (invisible)
    Set appWord = CreateObject("Word.Application")
    appWord.Visible = False

    ' Open the Word document
    Set doc = appWord.Documents.Open(strDocumentPath)
    
    ' Get total pages
    totalPages = doc.ComputeStatistics(wdStatisticPages)
    
    ' Define the split point (e.g., after half the pages)
    splitPoint = totalPages \ 2
    startPage = splitPoint + 1

    ' Copy pages from the split point to the end to a new document
    Set rng = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=startPage)
    Set rng = doc.Range(rng.Start, doc.Content.End)

    ' Create and save a new document for the second part
    Set newDoc = appWord.Documents.Add
    newDoc.Content.FormattedText = rng.FormattedText
    newDoc.SaveAs2 strOutputPath & "\Part2.docx"
    
    ' Remove the copied pages from the original document and save it
    rng.Delete
    doc.SaveAs2 strOutputPath & "\Part1.docx"

    ' Close documents and Word application
    newDoc.Close
    doc.Close
    appWord.Quit
    
    MsgBox "Document split successfully.", vbInformation
End Sub

VBA Word - Delete lines which contain specific text

The following VBA code deletes all lines from Word document which contain "Copy code" text. It also deletes the line before the text. Effectively, it deletes 2 lines in each iteration:

Sub DeleteLineBeforeAndContainingCopyCode()
    Dim doc As Document
    Dim currentPosition As Long
    Dim findRange As Range
    Dim deleteRange As Range

    ' Set the document
    Set doc = ActiveDocument

    ' Start from the bottom of the document
    currentPosition = doc.Content.End

    ' Loop until the top of the document
    Do While currentPosition > 0
        ' Set a range starting from the current position
        Set findRange = doc.Range(Start:=0, End:=currentPosition)

        ' Find the "Copy code" text
        With findRange.Find
            .Text = "Copy code"
            .Forward = False ' Search upwards
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
        End With

        If findRange.Find.Execute Then
            ' Create a range to delete the current and previous lines
            Set deleteRange = doc.Range(Start:=findRange.Paragraphs(1).Range.Start, _
                                        End:=findRange.Paragraphs(1).Range.End)

            ' Include the line above if it exists
            If findRange.Start > doc.Range.Start Then
                deleteRange.Start = deleteRange.Start - 1
                deleteRange.Start = deleteRange.Paragraphs(1).Range.Start
            End If

            ' Delete the range
            deleteRange.Delete

            ' Update the current position
            currentPosition = findRange.Start
        Else
            ' Exit the loop if "Copy code" is not found
            Exit Do
        End If
    Loop
    MsgBox "Done"
End Sub