Word 2003 Macro - need save file path code

Hello, I have an awesome little macro that I found on the net that saves pages from a merged doc to individual files. Through my testing of it I've found that when I run it directly from VBA it saves the resulting files in the same location as the original template file, which is fine. Except that I want to assign the macro to a button so it's available without having to go into VBA to run it. The only way I could save it to a button is by saving the macro under normal.dot which of course saves the resulting files wherever that file is (I'm not even sure where it is located!).
What I'm wondering is how do I adapt the code to specify a specific folder destination for the resulting files to be saved? I'm sure it's an easy tweek but I just can't figure it out!
Any help much appreciated.... (and I hope others find this code as helpful as I have. I got it from here: http://word.mvps.org/FAQs/MailMerge/index.htm)
Here's the code:
Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
End Sub
Sub AllSectionsToSubDoc(ByRef doc As Word.Document)
Dim secCounter As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
'Start from the end because creating
'Subdocs inserts additional sections
For secCounter = NrSecs - 1 To 1 Step -1
doc.Subdocuments.AddFromRange _
doc.Sections(secCounter).Range
Next secCounter
End Sub
Sub SaveAllSubDocs(ByRef doc As Word.Document)
Dim subdoc As Word.Subdocument
Dim newdoc As Word.Document
Dim docCounter As Long
docCounter = 1
'Must be in MasterView to work with
'Subdocs as separate files
doc.ActiveWindow.View = wdMasterView
For Each subdoc In doc.Subdocuments
Set newdoc = subdoc.Open
'Remove NextPage section breaks
'originating from mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
End Sub
Sub RemoveAllSectionBreaks(doc As Word.Document)
With doc.Range.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
End Sub