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

Do While .Execute(FindText:="Policy number [A-Z]{1,}[0-9]{1,}/[0-9]{1,}[A-Z]{1,}", MatchWildcards:=True)
            strText = orng.Text
            bFound = True
            vNumber = Split(strText, " ")
            ActiveDocument.SaveAs Filename:=strPath & Replace(Trim(vNumber(UBound(vNumber))), "/", "_") & ".docx"
            Exit Do
        Loop