The following should work. Write the strings to your worksheet 
Sub ExtractData(oDoc As Document)
Dim strName As String
Dim strAcc As String
Dim strBalance As String
Dim strScheme As String
Dim strDate As String
Dim strTotal As String
Dim oRng As Range
Dim oPara As Paragraph

    Set oRng = oDoc.Range
    For Each oPara In oRng.Paragraphs
        If Len(oPara.Range) > 1 Then
            strName = oPara.Range.Text
            If InStr(1, strName, Chr(46)) > 0 Then
                strName = Mid(strName, InStr(1, strName, Chr(46)) + 1)
                strName = Replace(strName, Chr(13), "")
            End If
            Exit For
        End If
    Next oPara
    With oRng.Find
        Do While .Execute("Account Number : ")
            strAcc = oRng.Next.Words(1)
            Exit Do
        Loop
    End With
    Set oRng = oDoc.Range
    With oRng.Find
        Do While .Execute("Currency : ")
            oRng.End = oRng.Paragraphs(1).Range.End - 1
            oRng.MoveStartUntil "0123456789"
            strBalance = oRng.Text
            Exit Do
        Loop
    End With
    Set oRng = oDoc.Range
    With oRng.Find
        Do While .Execute("Scheme : ")
            strScheme = oRng.Next.Words(1)
            Exit Do
        Loop
    End With
    Set oRng = oDoc.Range
    With oRng.Find
        Do While .Execute("Rephased on : ")
            oRng.Collapse 0
            oRng.MoveEndWhile "-0123456789"
            strDate = Replace(oRng.Text, "-", ".")
            Exit Do
        Loop
    End With
    Set oRng = oDoc.Range
    With oRng.Find
        Do While .Execute("TOTAL OVERDUE : ")
            oRng.Collapse 0
            oRng.MoveEndWhile ",.0123456789"
            strTotal = oRng.Text
            Exit Do
        Loop
    End With

    
    MsgBox strName & vbCr & _
    strAcc & vbCr & _
    strBalance & vbCr & _
    strScheme & vbCr & _
    strDate & vbCr & _
    strTotal
lbl_Exit:
    Exit Sub
End Sub

Sub Macro1()
    ExtractData ActiveDocument
End Sub