本代码中：拆分标记为"|"

Option Explicit
Const Token = "|"
Sub SplitDocumentByToken()
Dim oNewDoc As Document
Dim strSrcName As String, strNewName As String
Dim nStart As Long, nEnd As Long, nIndex As Long
Dim fContinue As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
strSrcName = ActiveDocument.FullName
nIndex = 1
fContinue = True
Selection.StartOf WdUnits.wdStory
Do While fContinue
nStart = Selection.Start
Selection.Find.ClearFormatting
With Selection.Find
'.Text = "^13" & Token & "^13"

.Text = Token
.Replacement.Text = ""
.Forward = True
.Wrap = WdFindWrap.wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute Then
nEnd = Selection.End
Else
nEnd = ActiveDocument.Content.End
fContinue = False
End If
ActiveDocument.Range(nStart, nEnd).Copy
strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
fso.GetBaseName(strSrcName) & "_" & nIndex & "." & fso.GetExtensionName(strSrcName))
Set oNewDoc = Documents.Add
Selection.Paste
oNewDoc.SaveAs strNewName
oNewDoc.Close False
nIndex = nIndex + 1
Selection.Collapse WdCollapseDirection.wdCollapseEnd
Loop
Set oNewDoc = Nothing
Set fso = Nothing
MsgBox "结束！"
End Sub