Consulting

Results 1 to 2 of 2

Thread: Making big docs into smaller documents. Please help.

  1. #1
    VBAX Newbie
    Joined
    Apr 2019
    Posts
    1
    Location

    Question Making big docs into smaller documents. Please help.

    I am learning VBA for Word and need some help please.

    I need to break a bunch of large Word documents into multiple smaller documents using VBA. The original files will remain unchanged. The bookmark names are always the same and they are just place markers within the documents.

    The documents look like this –

    BookmarkA
    .
    .
    .
    BookmarkB
    .
    .
    .
    BookmarkC
    .
    .
    .
    Etc.

    The result should be –
    File1:
    BookmarkA
    .
    .
    .


    File2:
    BookmarkB
    .
    .
    .
    BookmarkC
    .
    .
    .

    Would someone please help me get started with this code? Thanks for any help.

  2. #2
    If you want to save each section from one bookmark to the next and if your bookmark names really are BookmarkA, BookmarkB etc., and there are no other bookmarks in the document then the following will split them. The principles involved are to create a new document based on the original and then mark the parts to be removed as ranges and remove them.

    Option Explicit
    
    Sub Macro1()
    'Graham Mayor - https://www.gmayor.com - Last updated - 07 Apr 2019
    Dim oDoc As Document
    Dim oSource As Document
    Dim oRng As Range
    Dim iBM As Integer
    Dim strBM As String
        Set oSource = ActiveDocument
        oSource.Save
        If oSource.path = "" Then
            Beep
            GoTo lbl_Exit
        End If
        For iBM = 1 To oSource.Bookmarks.Count
            Set oDoc = Documents.Add(oSource.FullName)
            Set oRng = oDoc.Range
            Select Case iBM
                Case Is = 1
                    strBM = "Bookmark" & Chr(65 + iBM)
                    oRng.Start = oDoc.Bookmarks(strBM).Range.Start
                    oRng.Text = ""
                Case Is = oSource.Bookmarks.Count
                    strBM = "Bookmark" & Chr(64 + iBM)
                    oRng.End = oDoc.Bookmarks(strBM).Range.Start
                    oRng.Text = ""
                Case Else
                    strBM = "Bookmark" & Chr(64 + iBM)
                    oRng.End = oDoc.Bookmarks(strBM).Range.Start
                    oRng.Text = ""
                    oRng.End = oDoc.Range.End
                    strBM = "Bookmark" & Chr(65 + iBM)
                    oRng.Start = oDoc.Bookmarks(strBM).Range.Start
                    oRng.Text = ""
            End Select
            oDoc.SaveAs2 "C:\Path\Bookmark" & Chr(64 + iBM) & ".docx"
            oDoc.Close
            DoEvents
        Next iBM
    lbl_Exit:
        Set oDoc = Nothing
        Set oSource = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •