How to select the first word of a document - vba

Question

I'm trying to write a quick macro, to save my mail merged documents as separate documents, then save each individual document as the first word in each.
Here is what I have so far, to cut the document up, and save it as "Test_1" and so on, but I'm having trouble adding the code to select the first word.
Sub BreakOnSection()
'Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mailmerge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
'To save your document with the original formatting'
Selection.PasteAndFormat (wdFormatOriginalFormatting)
'Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "H:\Output"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
ActiveDocument.Close
'Move the selection to the next section in the document
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
Any help would be much appreciated.

Answer 1

Can you try this code:
Sub BreakOnSection()
'Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mailmerge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
'To save your document with the original formatting'
Selection.PasteAndFormat (wdFormatOriginalFormatting)
'Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
'Newly Added
'GoTo Starting of the Document
Selection.HomeKey Unit:=wdStory
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=True
Dim FileName As String
FileName = ReplaceIllegalChar(Trim(Selection.Text))
'End
ChangeFileOpenDirectory "H:\Output"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="test_" & FileName & ".doc"
ActiveDocument.Close
'Move the selection to the next section in the document
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
Function ReplaceIllegalChar(strIn As String) As String
Dim j As Integer
Dim varStr As String, xStr As String
varStr = strIn
For j = 1 To Len(varStr)
Select Case Asc(Mid(varStr, j, 1))
Case 48 To 57, 65 To 90, 97 To 122
xStr = xStr & Mid(varStr, j, 1)
Case Else
xStr = xStr & "_"
End Select
Next
ReplaceIllegalChar = xStr
End Function