Via VB best. Zeilen aus TXT-File in Excelsheet schreiben

Ich muss aus einer TXT.FILE die wie folgt aussieht (die Struktur wiederholt sich, da das File über 12000-Zeilen behinhaltet)
die Zeile zwischen den "-Zeichen(Anführungszeichen) rauskopieren und in Excel in eine bestimmte Spalte,z.B. A4, schreiben.
D.h. Ich gebe als Suchbegriff Description ein und alles was hinter Description zwischen den "-Zeichen steht, soll er rauskopieren und in Excel reinschreiben.

OPCMSG "BSH_APO"
DESCRIPTION "OVO/APO integration"
MSGGRP "APO"
MSGCONDITIONS
DESCRIPTION "MSG TYPE C/M/W SERVER blabla"
CONDITION_ID "0f58bla466-850d-71db-06fc-0a8blabla60000"
CONDITION
SEVERITY Warning Major Critical
NODE IP 10.blab.bla.91 "blabla.com"
TEXT "<*.txt>"
SET
APPLICATION "Automation Point"
MSGGRP "APblaO"
TEXT "NEW APO <txt>"
DESCRIPTION "MSG TYPE bla/lb/a SERVER blabla"
CONDITION_ID "00b91724-850d-71db-06fc-0a80809blabla"
CONDITION
SEVERITY Warning Major Critical
NODE IP 10.bla.blalba.92 "blalba.com"
TEXT "<*.txt>"


Das alles soll über VBA funktionieren.
Habe etwas ähnliches bereits gefunden:


Sub SuchenUndSchreiben()

On Error GoTo Fehler
Dim Datei As String
Dim Fnr As Long
Dim Trennzeichen As String
Dim Suchbegriff As String

Trennzeichen = ": "
Suchbegriff = "Description"
Datei = "C:\temp\Datei.txt"
Fnr = FreeFile
Open Datei For Input As #Fnr

While Not EOF(Fnr)
Line Input #Fnr, Zeile
tokens = Split(Zeile, Trennzeichen)
If tokens(0) = Suchbegriff Then Range("a3").Value = tokens(1)
Wend

Close #Fnr
Exit Sub

Fehler:
MsgBox "Es trat ein Fehler beim Öffnen der" & " Datei !", 16, "Problem"
Exit Sub
Resume Next


End Sub


Wäre wirklich Super, wenn mir jemand helfen könnte!
Vielen Dank das du dir mein Problem angeschaut hast!

Grüße CakeHead

Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objSourceFile = objFSO.OpenTextFile("c:\Source.txt", 1)	  
Set objExcel = CreateObject("Excel.Application")  
Set objWorkbook = objExcel.Workbooks.Add		
Set objWorkSheet = objWorkbook.Worksheets(1)		
				
Do Until objSourceFile.AtEndOfStream 				
     szNextLine = objSourceFile.Readline			
     tokens = Split(szNextLine, Chr(34))
     If tokens(0) = Suchbegriff Then
          objWorkSheet.Range("A3").Value = tokens(1)  
     end if
Loop

objWorkbook.SaveAs "C:\MappeX.xls"  
objExcel.Visible = True   

...
If tokens(0) = Suchbegriff Then 
...

Sub logfileLesenUndSuchen()

    On Error GoTo Fehler
    Dim logfile As String
    Dim Suchbegriff As String
    Dim iCounter As Integer
    Dim objFSO
    Dim objFile
    Dim Zeile As String
  
 'DESCRIPTION 2.  
 
    logfile = "C:\temp\logfile.txt"  
    Suchbegriff = "DESCRIPTION "  
  
    iCounter = 4       'setzt den Ausgangspunkt in 4.Zeile  
    Set objFSO = CreateObject("Scripting.FileSystemObject")  
    Set objFile = objFSO.OpenTextFile(logfile, 1)
    
    Do Until objFile.AtEndOfStream
        Zeile = objFile.ReadLine
        If InStr(1, Zeile, Suchbegriff) > 0 Then
            Cells(iCounter, 2).Value = Split(Zeile, Suchbegriff)(1)        'hier wird festgelegt in welcher Spalte gefundene Begriffe reingeschrieben werden  
            Cells(iCounter, 2).Value = ZeichenEntf(Cells(iCounter, 2).Value, """")  
            iCounter = iCounter + 1
        End If
    Loop
    objFile.Close
    Exit Sub

Fehler:
    MsgBox "Es trat ein Fehler beim Öffnen der" & _  
           " logfile !", 16, "Problem"  
    Exit Sub
    Resume Next

    
End Sub