1

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!

  • How many lines do you have? Bear in mind, VBA is single threaded and calls will block. As such, intensive loops will lock up excel until it completes. – Jonno Jan 19 '16 at 9:13
  • Did you check your RAM and CPU usage during this task? It may be your machine doens't have the resource (although I'd expect you'd see an "out of memory exception" message) – Dave Jan 19 '16 at 9:55
  • @Jonno: I have up to 20k lines. – Willi Fischer Jan 19 '16 at 11:28
  • @Dave: Since I am running this in a Citrix environment, I cannot monitor CPU and RAM, unfortunately – Willi Fischer Jan 19 '16 at 11:34
1

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
  • Thanks! While my initial code eventually worked after long waiting time, your solution seems to be a lot faster. I cannot upvote due to lack of reputation :( – Willi Fischer Jan 19 '16 at 16:25
  • @WilliFischer That's fine, I hit the rep limit for today anyway ;) Glad it worked for you, it seemed near instant when I tested it – Jonno Jan 19 '16 at 16:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.