
Microsoft Excel VBA: How to separate big XML-File into small ones
In this example, we do have a large XML file and we want to separate it into several small files. And we always want to copy out a very specific content of this file into individual files. My file looks like this:

As you can see by XML-View, there is a pattern recognizable:

It’s a large file with the XML of several Trades. As the System is called Calypso, the Trades are separated from the start “<CalypsoTrade>” to the end “<\CalypsoTrade>”. Each trade has an ID which is separated from the start “<TradeId>” to the end “<\TradeId>”.
In the given XML-file are exactly 100 Trades. So target is to have 100 files with the content of each trade.
I tried a code out of the Internet, but this one here did not work. I couldn’t find out why, although I included the corresponding libraries:
EinDatei = "D:\Gesamt.xml" Von = "<CalypsoTrade>" Bis = "</CalypsoTrade>" SuchName = "<TradeId>(.+)</TradeId>" 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
So I tried my own code which is shown below:

Private Sub Split() Dim regex As New RegExp Dim intLaenge As Long Dim Datei As String Dim Zusatz As String Datei = Sheets("Start").Range("C" & 12).Value EinDatei = Datei Zusatz = Sheets("Start").Range("C" & 14).Value Von = "<CalypsoTrade>" Bis = "</CalypsoTrade>" SuchName = "<TradeId>(.+)</TradeId>" Set fso = CreateObject("Scripting.FileSystemObject") EinOrdner = fso.GetParentFolderName(EinDatei) Set rE = New RegExp rE.Pattern = SuchName Inhalt = fso.OpenTextFile(EinDatei).ReadAll intLaenge = Len(Inhalt) Do While InStr(Inhalt, Von) > 0 Stelle1 = InStr(Inhalt, Von) Stelle2 = InStr(Inhalt, Bis) Stell = Stelle2 - Stelle1 Dim MyArray As String Dim MyArray1 As String MyArray = Mid(Inhalt, Stelle1, Stell + 15) DateiName = "TradeID_" & Mid(Inhalt, Stelle1 + 23, 8) & "_" & Zusatz & ".xml" fso.CreateTextFile(EinOrdner & "\" & DateiName).Write MyArray Inhalt = Replace(Inhalt, MyArray, "") Loop End Sub
As result, you receive this:
