Grosse XML Datei in n-kleine aufteilen. Möglichst als vbScript.

Ich bin bereits seit geraumer Zeit stiller Nutzer dieser Site und habe eigentlich zu allen Fragen eine Antwort gefunden. Allerdings habe ich nun ein Problem bei dem ich eure Hilfe brauche.

Eine größere XML Datei soll anhand einer bestimmten Node in kleine Dateien aufgeteilt werden.

Die Originaldatei sieht folgendermaßen aus:

<file>
<datensatz>
<bezeichnung>Name1</bezeichnung>
<feld1>11111</feld1>
<feld2>22222</feld2>
usw.
usw.
usw.
</datensatz>
<datensatz>
<bezeichnung>Name2</bezeichnung>
<feld1>33333</feld1>
<feld2>44444</feld2>
usw.
usw.
usw.
</datensatz>
<datensatz>
<bezeichnung>Name3</bezeichnung>
<feld1>55555</feld1>
<feld2>66666</feld2>
usw.
usw.
usw.
</datensatz>
</file>

Jetzt soll die Datei anhand der Datensätze aufgeteilt werden, wobei das Feld Bezeichnung den Datensatzname vorgibt.

Datei 1 heißt Name1 und hat den Inhalt ...
<datensatz>
<bezeichnung>Name1</bezeichnung>
<feld1>11111</feld1>
<feld2>22222</feld2>
usw.
usw.
usw.
</datensatz>

Datei 2 heißt Name2 und hat den Inhalt ...
<datensatz>
<bezeichnung>Name3</bezeichnung>
<feld1>33333</feld1>
<feld2>44444</feld2>
usw.
usw.
usw.
</datensatz>

und so weiter ...

Falls jemand von euch eine Idee hat so wäre ich sehr dankbar. Daher bereits jetzt vielen Dank im Voraus.

Thomas

EinDatei = "D:\Gesamt.xml"  
Von = "<datensatz>"  
Bis = "</datensatz>"  
SuchName = "<bezeichnung>(.+)</bezeichnung>"  

Set  fso = CreateObject("Scripting.FileSystemObject")  
EinOrdner = fso.GetParentFolderName(EinDatei)

set rE = New RegExp
rE.Pattern = SuchName

Inhalt = Split(fso.OpenTextFile(EinDatei).ReadAll, vbCrLF)

For i = 0 To UBound(Inhalt)
    If InStr(Inhalt(i), Von) > 0 Then
        Ausgabe = ""  
        AusDatei = ""  
        Collect = True
    End If
    If InStr(Inhalt(i), Bis) > 0 Then
        Ausgabe = Ausgabe & Inhalt(i)
        Set GefundenNamen = rE.Execute(Ausgabe)
        For Each GefundenName In GefundenNamen
            AusDatei = GefundenName.SubMatches(0)
        Next
        If AusDatei <> "" Then  
            fso.CreateTextFile(EinOrdner & "\" & AusDatei).Write Ausgabe  
        Else
            fso.OpenTextFile(EinOrdner & "\" & "Error.txt", 8, 1).Write "Kein Dateiname gefunden in " & vbCrLF & Ausgabe & vbCrLF & vbCrLF  
        End If
        Collect = False
    End If
    If Collect Then
        Ausgabe = Ausgabe & Inhalt(i) & vbCrLf
    End If
Next

<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<besuchsbericht>
    <betreff>Übersicht der anstehenden Änderungen</betreff>
    <kontakt>Klaus Mustermann</kontakt>
    <firma>Mustermann GmbH & Co KG</firma>
    <datum>2009.03.01</datum>
    <detail1>AAAAAAAAAAA</detail1>
    <detail2>BBBBBBBBBBB</detail2>
</besuchsbericht>

Übersicht der anstehenden Änderungen

<besuchsbericht>
    <betreff>Übersicht der anstehenden Änderungen</betreff>
    <kontakt>Klaus Mustermann</kontakt>
    <firma>Mustermann GmbH & Co KG</firma>
    <datum>2009.03.01</datum>
    <detail1>AAAAAAAAAAA</detail1>
    <detail2>BBBBBBBBBBB</detail2>
</besuchsbericht>

Inhalt = Split(fso.OpenTextFile(EinDatei,1,False,True).ReadAll, vbCrLF)

fso.CreateTextFile(EinOrdner & "\" & AusDatei,True,True).Write Ausgabe

fso.OpenTextFile(EinOrdner & "\" & "Error.txt",8,True,True).Write "Kein Dateiname gefunden in " & vbCrLF & Ausgabe & vbCrLF & vbCrLF

Inhalt = Split(fso.OpenTextFile(EinDatei,1,False,True).ReadAll, vbCrLF)

Skript:    d:\Labor\sp.vbs
Zeile:     12
Zeichen:   1
Fehler:    Objekt erforderlich: 'Wahr'
Code:      800A01A8
Quelle:    Laufzeitfehler in Microsoft VBScript

AusDatei = Conv(AusDatei) 'UTF-8-Text konvertieren

Function Conv(UTF8String)
Set Stream = CreateObject("ADODB.Stream")  
With Stream
    .Type = 2
    .Open
    .Charset = "Windows-1252"  
    .WriteText UTF8String
    .Position = 0
    .Charset = "UTF-8"  
    Conv = .ReadText
End With
Stream.Close
Set Stream = Nothing
End Function