Save as XML with VBA?

后端 未结 2 1603
执笔经年
执笔经年 2021-01-11 22:55

Is there any way to save an Excel table as XML? I have the XML Schema file... and some data in a table... and I have in Excel the Save as XML file option but can I save a fi

相关标签:
2条回答
  • 2021-01-11 23:12

    the good ol' macro recorder saved me this time :)) (Why didn't I used it before I posted here?) So... To load an xml schema you have:

    ActiveWorkbook.XmlMaps.Add("Book2.xml", "raport").Name _
            = "raport_Map"
    

    And to save it as xml:

    ActiveWorkbook.SaveAsXMLData Filename:="Book3.xml", _
            Map:=ActiveWorkbook.XmlMaps("raport_Map")
    

    Who would have thought that it's that easy?

    0 讨论(0)
  • 2021-01-11 23:24

    This link helped me the most -> http://curiousmind.jlion.com/exceltotextfile

    Script on link:

    Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)
        Dim Q As String
        Q = Chr$(34)
    
        Dim sXML As String
    
        sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
        sXML = sXML & "<rows>"
    
    
        ''--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 & "<row 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 & "</row>"
            iRow = iRow + 1
        Wend
        sXML = sXML & "</rows>"
    
        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
    End Sub
    
    Sub test()
        MakeXML 1, 2, "C:\Users\jlynds\output2.xml"
    End Sub
    
    0 讨论(0)
提交回复
热议问题