Function ExtractText(oDoc As Document) As Boolean
Dim oRng As Range
Dim oNewDoc As Document
Dim strNewName As String
Const strStart As String = "The information received does not support the service requested:"
Const strEnd As String = "The above actions are supported by the following:"
    On Error GoTo Err_Handler
    Set oRng = oDoc.Range
    With oRng
        .Start = .Start + InStr(oRng, strStart) - 1 
        .End = .Start + InStr(oRng, strEnd) + 1
        .MoveEndUntil Chr(58)
        .End = .End + 1
        If Len(.Text) > 0 Then
            Set oNewDoc = Documents.Add(Template:=oDoc.FullName, Visible:=True)
            oNewDoc.Range.FormattedText = oRng.FormattedText
            strNewName = oDoc.FullName
            strNewName = Left(strNewName, InStrRev(strNewName, Chr(46)) - 1)
            strNewName = strNewName & "EN"
            strNewName = strNewName & Right(oDoc.name, Len(oDoc.name) - InStrRev(oDoc.name, Chr(46)) + 1)
            oNewDoc.SaveAs strNewName, addtorecentfiles:=False
            oNewDoc.Close 0
        End If
    End With
    ExtractText = True

lbl_Exit:
    Exit Function
Err_Handler:
    ExtractText = False
End Function