如何从Excel VBA宏生成XML？

Question

所以,我有一堆以Excel电子表格形式发送给我们的内容.我需要将该内容转移到另一个系统中.另一个系统从XML文件中获取其输入.我可以手工完成所有这些(相信我,管理层没有问题让我这样做!),但我希望有一种简单的方法来编写一个Excel宏,它将生成我需要的XML.这对我来说似乎是一个更好的解决方案,因为这是一项需要定期重复的工作(我们将在Excel工作表中获得大量内容)并且有一个批处理工具为我们做这件事是有意义的.

但是,我以前从未尝试过从Excel电子表格生成XML.我有一点VBA知识,但我是XML的新手.我猜我在谷歌搜索的问题是我甚至不知道谷歌的用途.谁能给我一点方向让我开始？我的想法听起来像是解决这个问题的正确方法,还是我忽略了一些明显的东西？

谢谢StackOverflow!

Answer 1

您可能想要考虑ADO - 工作表或范围可以用作表格.

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adPersistXML = 1

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

''It wuld probably be better to use the proper name, but this is
''convenient for notes
strFile = Workbooks(1).FullName

''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns, note also that you will need a different connection
''string for >=2007
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
        & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"


cn.Open strCon
rs.Open "Select * from [Sheet1$]", cn, adOpenStatic, adLockOptimistic

If Not rs.EOF Then
    rs.MoveFirst
    rs.Save "C:\Docs\Table1.xml", adPersistXML
End If

rs.Close
cn.Close

Answer 2

致谢：curiousmind.jlion.com/exceltotextfile（链接不再存在）

脚本：

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