Sub Export2XL()
    Dim app As Object
    Dim wbk As Object
    Dim wsh As Object
    Dim r As Long
    Dim p As Long
    Dim n As Long
    Dim i As Long
    Dim arr As Variant
    Dim strLine As String
    ' Start Excel
    On Error Resume Next
    Set app = GetObject(Class:="Excel.Application")
    If app Is Nothing Then
        Set app = CreateObject(Class:="Excel.Application")
        If app Is Nothing Then
            MsgBox "Can't start Excel!", vbExclamation
            Exit Sub
        End If
    End If
    On Error GoTo ErrHandler
    ' Create workbook with one worksheet
    app.ScreenUpdating = False
    Set wbk = app.Workbooks.Add(Template:=-4167) ' xlWBATWorksheet
    Set wsh = wbk.Worksheets(1)
    r = 1
    wsh.Cells(r, 1) = "PTF"
    wsh.Cells(r, 2) = "DEF"
    wsh.Cells(r, 3) = "PURCHASER"
    wsh.Cells(r, 4) = "ADDRESS"
    wsh.Cells(r, 5) = "AMOUNT"
    ' Date
    strLine = ActiveDocument.Paragraphs(1).Range.Text
    p = InStr(strLine, vbTab)
    strLine = Mid(strLine, p + 1, Len(strLine) - p)
    wsh.Name = strLine
    ' Loop
    n = ActiveDocument.Paragraphs.Count
    For i = 2 To n
        strLine = ActiveDocument.Paragraphs(i).Range.Text
        strLine = Left(strLine, Len(strLine) - 1)
        arr = Split(strLine, vbTab)
        ' Determine type
        If arr(2) = "PTF" Then
            r = r + 1
            wsh.Cells(r, 1) = arr(3)
        ElseIf arr(1) = "DEF" Then
            wsh.Cells(r, 2) = arr(2)
        ElseIf arr(1) = "COUNT" And UBound(arr) >= 3 Then
            wsh.Cells(r, 3) = arr(3)
        ElseIf arr(1) = "ADDRESS" Then
            wsh.Cells(r, 4) = arr(2)
            wsh.Cells(r, 5) = arr(4)
        Else
            ' Footer - ignore
        End If
    Next i
ExitHandler:
    If Not app Is Nothing Then
        wsh.Range("A1:E1").EntireColumn.AutoFit
        app.ScreenUpdating = True
        app.Visible = True
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub