View Single Post
 
Old 09-03-2016, 07:34 AM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,617
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote