View Full Version : Making big docs into smaller documents. Please help.
Jagrantz
04-06-2019, 01:26 PM
I am learning VBA for Word and need some help please.:banghead:
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.
gmayor
04-06-2019, 09:14 PM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.