VBA to split word document containing pictures using delimter

uday.word · #1 09-01-2016, 07:34 AM

I have been using the below code to split word documents to multiple sub documents with the help of delimiter. Now my word file contains pictures inserted between the text and this macro is not able to read them. This macro simply splits the text only.

Can any one please help me on this?? I need the macro to work on pictures as well and gets split accordingly.

Option Explicit

Sub SplitNotes(delim As String, strFilename As String)

Dim doc As Document
Dim arrNotes
Dim I As Long
Dim X As Long
Dim Response As Integer

arrNotes = Split(ActiveDocument.Range, delim)

Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to proceed?", 4)
If Response = 7 Then Exit Sub
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000")
doc.Close True
End If
Next I
End Sub

Sub test()
' delimiter & filename
SplitNotes "///", "Notes "
End Sub

Any solution on this helpful. Many thanks!

gmaxey · #2 09-03-2016, 07:34 AM

Code:

Option Explicit
Sub test()
  SplitNotes "///", "Notes "
lbl_Exit:
  Exit Sub
End Sub
Sub SplitNotes(strDelim As String, strFilename As String)
Dim oDoc As Document
Dim lngIndex As Long, lngCount As Long
Dim oRng As Range
Dim oCol As New Collection
Dim bFound As Boolean
  bFound = False
  Set oDoc = ActiveDocument
  Set oRng = oDoc.Range
  With oRng.Find
    .Text = strDelim
    While .Execute
      If lngCount = 0 Then
        oRng.Start = ActiveDocument.Range.Start
        oCol.Add oRng.Duplicate
        oRng.Collapse wdCollapseEnd
        lngCount = lngCount + 1
        bFound = True
      Else
        oRng.Start = oCol.Item(lngCount).End
        oCol.Add oRng.Duplicate
        oRng.Collapse wdCollapseEnd
      End If
    Wend
    If bFound Then
      oRng.End = ActiveDocument.Range.End - 1
      oRng.InsertAfter strDelim
      oCol.Add oRng.Duplicate
    End If
  End With
  If oCol.Count > 0 Then
    If MsgBox("This will split the document into " & oCol.Count & " sections. Do you wish to proceed?", _
               vbQuestion + vbYesNo, "SPlIT") = vbNo Then Exit Sub
  End If
  For lngIndex = 1 To oCol.Count
    Set oDoc = Documents.Add
    oDoc.Range.FormattedText = oCol.Item(lngIndex).FormattedText
    For lngCount = 1 To Len(strDelim)
      oDoc.Range.Characters.Last.Previous.Delete
    Next
    oDoc.SaveAs ThisDocument.Path & "\" & strFilename & Format(lngIndex, "000")
    oDoc.Close True
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub

uday.word · #3 09-06-2016, 05:27 AM

Your solution has worked brilliant. This is what I exactly wanted. This code has taught me many additional syntax and has motivated my interest in learning it.

Thank you Sir!
Looking forward for your support and guidance for my learning.

I have seen your website. You are a great patriot and passionate guy.

Tom Saylor · #4 09-11-2016, 03:40 AM

Hi Greg,

Thanks for providing this useful macro! I'm encountering a bit of a problem. When I run the macro on a Word file with multiple instances of the delimiter (///) embedded between equal portions of text, I get the desired output for the first two result files (Notes 001 and Notes 002) but not for the subsequent result files (Notes 003 and ff.).

In Notes 001 I get only the text found before the first delimiter, and in Notes 002 I get only the text found between the first and second delimiters--good!

But in Notes 003 I get the text found between the second and fourth delimiters along with the text of the third delimiter itself (///). In Notes 004 I gets the text found between the third and sixth delimiters along with the texts of the fourth and fifth delimiters themselves. And so forth, so that each subsequent result file contains more and more undesired text.

Is there a way to tweak the macro so that the subsequent result files (Notes 003 and ff.) contain only the text between adjacent delimiters?

Thanks!

gmaxey · #5 09-11-2016, 05:15 AM

Change:
oRng.Start = oCol.Item(lngCount).End
To:
oRng.Start = oCol.Item(oCol.Count).End

or just add lngCount = lngCount + 1 after that existing line.

Tom Saylor · #6 09-11-2016, 05:59 AM

Wonderful! That did the trick! Thanks so much, Greg!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Word VBA - Split Document By Headings - Save File Name As Heading Name	jc491	Word VBA	7	01-21-2022 11:04 AM
split word document based on bookmarks with each new document title of the bookmark	megatronixs	Word VBA	9	09-05-2020 02:29 PM
Split one Word Document into Multiple PDFs	VieraOfficeUser	Word	3	07-30-2014 10:58 PM
Split a word document	officeboy09	Word VBA	6	04-12-2014 05:07 AM
How do I see one document map for each half of a split MS WORD 2010 document?	quickwin	Word	3	07-09-2013 10:20 PM