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:

(Enlarge Picture)

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

(Enlarge Picture)

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:

(Enlarge Picture)

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:

(Enlarge Picture)

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.

About Miss Ob·so·let

Imperfection is beauty, madness is genious. it is better to be absolutely ridiculous than absolutely boring.

Category

nice to know

Tags

, , , , , , , , , , ,