Jtdylktuy

I have VBA code that wirtes an Excel table to an xml file (actually writing the xml file line by line, tags equal column headers).

This is the code, it is quite straight forward.

Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)

    Dim Q As String

    Dim NodeName As String

    Dim AtributName As String



    Application.ScreenUpdating = False



    Q = Chr$(34)



    Dim sXML As String



    sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"

    sXML = sXML & "<root>"



    NodeName = "node"

    AtributName = "test"



    ''--determine count of columns

    Dim iColCount As Integer

    iColCount = 1

    While Trim$(Cells(iCaptionRow, iColCount)) > ""

        iColCount = iColCount + 1

    Wend



    Dim iRow As Integer

    iRow = iDataStartRow



    While Cells(iRow, 1) > ""

        sXML = sXML & "<" & NodeName & " type=" & Q & AtributName & Q & " id=" & Q & iRow & Q & ">"



        For icol = 1 To iColCount - 1

           sXML = sXML & "<" & Trim$(Cells(iCaptionRow, icol)) & ">"

           sXML = sXML & Trim$(Cells(iRow, icol))

           sXML = sXML & "</" & Trim$(Cells(iCaptionRow, icol)) & ">"

        Next



        sXML = sXML & "</" & NodeName & ">"

        iRow = iRow + 1

    Wend

    sXML = sXML & "</root>"



    Dim nDestFile As Integer, sText As String



    ''Close any open text files

    Close



    ''Get the number of the next free text file

    nDestFile = FreeFile



    ''Write the entire file to sText

    Open sOutputFileName For Output As #nDestFile

    Print #nDestFile, sXML

    Close



    Application.ScreenUpdating = True





End Sub



Sub ExcelToXml()

    Dim FileName As String

    FileName = InputBox("Dateinamen eingeben:")

    Call MakeXML(1, 2, ActiveWorkbook.Path & "" & FileName & ".xml")

End Sub

The problem I have here occurs at files of around 2000 lines (also depends on the number of columns): Excel freezes and I have to kill it. i assume there might be a memory problem. How can I make this more stable?

Thanks!

I used the same code, and it works but it does lock up the CPU for a very long time working it out. Excel is still working, but it freezes up the user interface as VBA uses a single thread.

I've adapted it to dump straight to a file stream, instead of holding it in memory and writing it all at the end, try replacing your MakeXML function with this. You will also be able to monitor the file as it's being written to see if it does indeed crash and it hopefully should run faster. Let me know if there are any problems and I can tweak the code.

Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)

    Dim Q As String

    Dim NodeName As String

    Dim AtributName As String

    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim oFile As Object





    Set oFile = fso.CreateTextFile(sOutputFileName)



    Application.ScreenUpdating = False



    Q = Chr$(34)



    oFile.Write "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"

    oFile.Write "<root>"



    NodeName = "node"

    AtributName = "test"



    ''--determine count of columns

    Dim iColCount As Integer

    iColCount = 1

    While Trim$(Cells(iCaptionRow, iColCount)) > ""

        iColCount = iColCount + 1

    Wend



    Dim iRow As Integer

    iRow = iDataStartRow



    While Cells(iRow, 1) > ""

        oFile.Write "<" & NodeName & " type=" & Q & AtributName & Q & " id=" & Q & iRow & Q & ">"



        For icol = 1 To iColCount - 1

           oFile.Write "<" & Trim$(Cells(iCaptionRow, icol)) & ">"

           oFile.Write Trim$(Cells(iRow, icol))

           oFile.Write "</" & Trim$(Cells(iCaptionRow, icol)) & ">"

        Next



        oFile.Write "</" & NodeName & ">"

        iRow = iRow + 1

    Wend

    oFile.Write "</root>"





    oFile.Close



    Application.ScreenUpdating = True





End Sub