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:
miss.ob·so·let 