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