Sub SavePolicyDoc()
Dim orng As Range
Dim vNumber As Variant
Dim strText As String
Dim bFound As Boolean
Const strPath As String = "" 'Put the folder path here e.g. "C:\Path\"
    Set orng = ActiveDocument.Range
    With orng.Find
        Do While .Execute(FindText:="Policy number -  [0-9]{1,}", MatchWildcards:=True)
            strText = orng.Text
            bFound = True
            vNumber = Split(strText, "-")
            ActiveDocument.SaveAs Filename:=strPath & Trim(vNumber(UBound(vNumber))) & ".docx"
            Exit Do
        Loop
        If Not bFound Then MsgBox "The policy number was not found"
    End With
    Set orng = Nothing
End Sub