Option Explicit

Sub MySave()
'Graham Mayor - http://www.gmayor.com - Last updated - 09/03/2017
Dim oStory As Range
Dim strDate As String
Dim strName As String
    For Each oStory In ActiveDocument.StoryRanges
        strDate = FindDate(oStory)
        If Not strDate = "" Then Exit For
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                strDate = FindDate(oStory)
                If Not strDate = "" Then Exit For
            Wend
        End If
    Next oStory
    If strDate = "" Then
        MsgBox "Date not found"
        GoTo lbl_Exit
    End If
    strName = strDate & Chr(32) & ActiveDocument.Name
    ActiveDocument.SaveAs2 strName, 12
    Set oStory = Nothing
lbl_Exit:
    Exit Sub
End Sub

Function FindDate(oRng As Range) As String
'Graham Mayor - http://www.gmayor.com - Last updated - 09/03/2017
    With oRng.Find
        Do While .Execute(FindText:="[0-9]{2}.[0-9]{2}.[0-9]{4}", _
                          MatchWildcards:=True)
            FindDate = oRng.Text
            Exit Do
        Loop
    End With
lbl_Exit:
    Exit Function
End Function