Word VBA automated save file name
Hello,
I have current
VBA project that take the output of an
Access report that has been brought into Word as an .rtf
file. These Access reports are grouped as well. What my
coding does is after Access has created the .rtf file (up
to 200+ plus) it takes codes from Microsoft Q article
Q216845 and creates a seperate document for each section.
This code works just fine. Then, it saves it as a
specific file name and searches for the 11th to the 13th
character. This works just fine also. However, the
project has now changed as to where I can not tell it to
just use character #11 to 13. I need to have it look for
a specific word with a colon after it, then take the next
word as the file name, and this might be 2 or 3 words
also. I can not seem to get this to work. Below is the
coding that I know works that I have been trying to
modify:
Dim rngTitle As Range
Dim strTitle As String
' Find "xyz" and replace with Section Break Next Page,_
remove Page Break
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "xyz"
.Forward = True
.Wrap = wdFindContinue
End With
If Selection.Find.Execute = False Then
Exit Do
Else
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.InsertBreak Type:=wdSectionBreakNextPage
End If
Loop
Selection.HomeKey Unit:=wdStory
' Used to set criteria for moving through the document_
by section.
Application.Browser.Target = wdBrowseSection
'A mailmerge documents 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
Selection.Paste
' 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
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "J:\Working Files\Reports"
Set rngTitle = ActiveDocument.Range(Start:=11,_
End:=13)
strTitle = rngTitle.Text
ActiveDocument.SaveAs FileName:="Territory " &_
strTitle & " Report" & ".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 is GREATLY appreciated!
Thanks.
JS.
