That macro would work if the document has previously been saved, otherwise there is no path associated with the document. I would suggest, based on your code which I assume works in your document:
Code:
Dim wbname As String
Dim filePATH As String
Dim datefrom As String
Dim dateto As String
Dim fDialog As FileDialog
If ActiveDocument.path = "" Then
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder to save the document"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
filePATH = ""
Else
filePATH = fDialog.SelectedItems.Item(1) & Chr(92)
End If
End With
Else
filePATH = ActiveDocument.path
End If
If filePATH = "" Then
MsgBox "No folder selected", vbCritical
Exit Sub
End If
' Selection.Find.ClearFormatting
Selection.HomeKey wdStory
With Selection.Find
.Text = "????.??.??"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
datefrom = Selection.Text
If Len(datefrom) < 8 Then
MsgBox "Date From - not found", vbCritical
Exit Sub
End If
datefrom = Right(datefrom, 8)
Selection.Collapse 0
Selection.Find.Execute
dateto = Selection.Text
If Len(dateto) < 8 Then
MsgBox "Date To - not found", vbCritical
Exit Sub
End If
dateto = Right(dateto, 8)
wbname = datefrom & "-" & dateto
ActiveDocument.SaveAs FileName:=filePATH & wbname & ".doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False