Textdatei nach bestimmten Wörtern durchsuchen mit VB oder Batch

Hallo,
zunächst begrüße ich dies hilfreiche Forum. Bisher habe ich mir hier immer gute Lösungen oder Lösungsansätze rausziehen können, jetzt musste ich aber selbst eine Frage erstellen, da ich einfach nicht weiter komme. Ich beschäftige mich einfach zu selten mit VB und Batch, obwohl es immer wieder Spaß macht.

Mein Anliegen: Aus folgendem Beispieltext sollen bestimmte Einträge, welche im gleichen Archiv xxx liegen, in eine neue Textdatei (oder csv) geschrieben werden.
Also alle Zeilen (Ordner/Schrank/Sachbearbeiter/Raum) geordnet nach dem Archiv hintereinander (optional mit Semikolon als Trennzeichen) oder untereinander.


usw...


Gewünschtes Ergebnis in einer Textdatei:

Archiv 123
Ordner : A 12345-12;Schrank: C7;Sachbearbeiter: Mustermann1;Raum: 321
Ordner : A 54321-12;Schrank: G6;Sachbearbeiter: Mustermann3;Raum: 876
…

Archiv 234
Ordner : A 23456-12;Schrank: D8;Sachbearbeiter: Mustermann2;Raum: 543
Ordner : A 65432-12; Schrank: F4;Sachbearbeiter: Mustermann4;Raum: 777
…

Archiv 456
…

Oder:

Archiv 123
Ordner : A 12345-12
Schrank: C7
Sachbearbeiter: Mustermann1
Raum: 321
Ordner : A 54321-12
Schrank: G6
Sachbearbeiter: Mustermann3
Raum: 876

Archiv 234
Ordner : A 23456-12
Schrank: D8
Sachbearbeiter: Mustermann2
Raum: 543
Ordner : A 65432-12
Schrank: F4
Sachbearbeiter: Mustermann4
Raum: 777

Archiv 456
…


Ich habe mich mit folgendem Code versucht, weiß aber einfach nicht weiter. Vielleicht doch lieber was als Batch (findstr) ?

Set MyShell=wscript.CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2
strSourceFile = "c:\Archiv\archiv.txt"
strDestFile = "c:\Archiv\sorted.txt"

Set fin = fso.OpenTextFile(strSourceFile, ForReading)
Set fout = fso.OpenTextFile(strDestFile, ForWriting, True)

do while not fin.AtEndOfStream
strInLine = fin.Readline
if instr(strInLine, "Archiv 123") > 0 then
strOutLine = mid(strInLine,30)
end if
if instr(strInLine, "Ordner") > 0 then
strOutLine = strOutLine & " " & mid(strInLine,1)
end if
if instr(strInLine, "Schrank") > 0 then
strOutLine = strOutLine & " " & mid(strInLine,1)
end if
if instr(strInLine, "Sachbearbeiter") > 0 then
strOutLine = strOutLine & " " & mid(strInLine,1)
end if
if instr(strInLine, "Raum") > 0 then
strOutLine = strOutLine & " " & mid(strInLine,1)
fout.writeline strOutLine
end if
Loop


Das Ergebnis geht schon mal so halbwegs in die Richtung, aber irgendwie komme ich als absoluter Laie nicht weiter. Hier sucht er im Loop ja nur nach dem Archiv 123 (und das auch nicht ganz korrekt), wie kann ich dies für die anderen Archive wiederholen? Die Auflistung ist auch nicht richtig. Wäre super wenn mir jemand helfen könnte, ob mit VB oder vielleicht mit einer Batchdatei wäre egal. Die Zeilenanzahl ist übrigens nicht immer gleich, das Archiv steht immer in ><, kann aber in der Länge varieren (z.B. >Archiv 234_a<), die Angaben "Ordner, Schrank, Sachbearbeiter und Raum" stehen immer einzeln in einer Zeile.
Ich hoffe die Angaben sind verständlich, ansonsten bitte Fragen.

Vielen Dank für hilfreiche Beiträge!
Gruß nick909

    Option Explicit

    Const FileIn = "C:\Archiv\Archiv.txt"  
    Const FileOut = "C:\Archiv\Sorted.txt"  


    Dim Fso, File, TextIn, TextOut, Targets, Token, Archiv, Liste, Key, i, t
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    Set Liste = CreateObject("Scripting.Dictionary")  
    
    Set File = Fso.OpenTextFile(FileIn)
    
    TextIn = Split(File.ReadAll, ">Archiv"):   File.Close  
    
    Targets = Array("Ordner", "Schrank", "Sachbearbeiter", "Raum")  
    
    ReDim Token(UBound(Targets))
    
    For i = 1 To UBound(TextIn)
        Archiv = "Archiv" & Split(TextIn(i), "<")(0)  
        
        For t = 0 To UBound(Targets)
            If InStr(1, TextIn(i), Targets(t), vbTextCompare) > 0 Then
                Token(t) = Targets(t) & Split(Split(TextIn(i), Targets(t))(1), vbCrLf)(0)
            Else
                Token(t) = "nv"  
            End If
        Next
        
        With Liste
            If .Exists(Archiv) Then
                .Item(Archiv) = .Item(Archiv) & vbCrLf & Join(Token, ";")  
            Else
                .Add Archiv, Join(Token, ";")  
            End If
        End With
    Next

    For Each Key In Liste.Keys
        TextOut = TextOut & Key & vbCrLf & Liste.Item(Key) & vbCrLf & vbCrLf
    Next
    
    Set File = Fso.CreateTextFile(FileOut)
    
    File.Write TextOut:   File.Close

Archiv 123
Ordner : A 12345-12;Schrank: C7;Sachbearbeiter: Mustermann1;Raum: 321
Ordner : A 54321-12;Schrank: G6;Sachbearbeiter: Mustermann3;Raum: 876

Archiv 234_a
Ordner : A 23456-12;Schrank: D8;Sachbearbeiter: Mustermann2;Raum: 543
Ordner : A 65432-12;Schrank: F4;Sachbearbeiter: Mustermann4;Raum: 777

Archiv 456
nv;nv;nv;nv