logo标签列表

如何从Excel VBA宏生成XML？

xmlexcelvba
8
所以，我们收到了一堆Excel电子表格形式的内容。我需要将这些内容转移到另一个系统中。该系统从XML文件中获取输入。我可以手动完成所有操作（相信我，管理层也不介意让我这样做！），但我希望有一种简单的方法编写Excel宏来生成所需的XML。对我来说，这似乎是更好的解决方案，因为这是一个需要定期重复的工作（我们会得到大量的Excel表格内容），而且使用批处理工具更加合理。
然而，我以前从未尝试过从Excel电子表格生成XML。我有一点VBA知识，但对于XML来说还是个新手。我在谷歌上搜索时遇到的问题是我甚至不知道该搜索什么。有人能给我一点指导吗？我的想法是否是解决这个问题的正确方式，或者我忽略了一些明显的问题？
感谢StackOverflow！
4个回答
8

您可能想考虑使用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
这比使用循环处理200,000行+1要好得多 :) - Our Man in Bananas
@Fionnuala 非常感谢。我正在使用 Windows 10 64 位，并从此链接 https://learn.microsoft.com/en-us/sql/connect/oledb/download-oledb-driver-for-sql-server?view=sql-server-2017 安装了 oledb。但是在这一行 cn.Open strCon 我遇到了错误。看起来是提供程序的问题，所以我使用了 Provider=MSOLEDBSQL。但是在下一行中出现了错误 Invalid connection string attribute。 - YasserKhalil
4
Credit to: 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
1
我认为VBA中的默认输出编码不是UTF-8。 - Wernfried Domscheit
2
如果您的Excel数据包含像<或>这样的字符会发生什么？文件将变得不规范。 - Wernfried Domscheit
这是正确的。我们有两个选择：1. 在Excel中输入文本时处理不支持的字符，或者2. 在生成XML时对字符进行编码。 - Solata
0
这是一个示例宏，用于将Excel工作表转换为XML文件。
#'vba code to convert excel to xml

Sub vba_code_to_convert_excel_to_xml()
Set wb = Workbooks.Open("C:\temp\testwb.xlsx")
wb.SaveAs fileName:="C:\temp\testX.xml", FileFormat:= _
        xlXMLSpreadsheet, ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

此宏将从C驱动器打开现有的Excel工作簿，并将文件转换为XML格式，然后将文件以.xml扩展名保存在指定的文件夹中。我们使用Workbook Open方法打开文件，使用SaveAs方法将文件保存到目标文件夹中。如果您想将目录中的所有Excel文件转换为XML（xlXMLSpreadsheet格式）文件，则此示例将非常有用。
-3

这是另一个版本 - 这将有助于通用性

Public strSubTag As String
Public iStartCol As Integer
Public iEndCol As Integer
Public strSubTag2 As String
Public iStartCol2 As Integer
Public iEndCol2 As Integer

Sub Create()
Dim strFilePath As String
Dim strFileName As String

'ThisWorkbook.Sheets("Sheet1").Range("C3").Activate
'strTag = ActiveCell.Offset(0, 1).Value
strFilePath = ThisWorkbook.Sheets("Sheet1").Range("B4").Value
strFileName = ThisWorkbook.Sheets("Sheet1").Range("B5").Value
strSubTag = ThisWorkbook.Sheets("Sheet1").Range("F3").Value
iStartCol = ThisWorkbook.Sheets("Sheet1").Range("F4").Value
iEndCol = ThisWorkbook.Sheets("Sheet1").Range("F5").Value

strSubTag2 = ThisWorkbook.Sheets("Sheet1").Range("G3").Value
iStartCol2 = ThisWorkbook.Sheets("Sheet1").Range("G4").Value
iEndCol2 = ThisWorkbook.Sheets("Sheet1").Range("G5").Value

Dim iCaptionRow As Integer
iCaptionRow = ThisWorkbook.Sheets("Sheet1").Range("B3").Value
'strFileName = ThisWorkbook.Sheets("Sheet1").Range("B4").Value
MakeXML iCaptionRow, iCaptionRow + 1, strFilePath, strFileName

End Sub


Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFilePath As String, sOutputFileName As String)
    Dim Q As String
    Dim sOutputFileNamewithPath As String
    Q = Chr$(34)

    Dim sXML As String


    '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
    Dim iCount  As Integer
    iRow = iDataStartRow
    iCount = 1
    While Cells(iRow, 1) > ""
        'sXML = sXML & "<row id=" & Q & iRow & Q & ">"
        sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
        For iCOl = 1 To iColCount - 1
          If (iStartCol = iCOl) Then
               sXML = sXML & "<" & strSubTag & ">"
          End If
          If (iEndCol = iCOl) Then
               sXML = sXML & "</" & strSubTag & ">"
          End If
         If (iStartCol2 = iCOl) Then
               sXML = sXML & "<" & strSubTag2 & ">"
          End If
          If (iEndCol2 = iCOl) Then
               sXML = sXML & "</" & strSubTag2 & ">"
          End If
           sXML = sXML & "<" & Trim$(Cells(iCaptionRow, iCOl)) & ">"
           sXML = sXML & Trim$(Cells(iRow, iCOl))
           sXML = sXML & "</" & Trim$(Cells(iCaptionRow, iCOl)) & ">"
        Next

        'sXML = sXML & "</row>"
        Dim nDestFile As Integer, sText As String

    ''Close any open text files
        Close

    ''Get the number of the next free text file
        nDestFile = FreeFile
        sOutputFileNamewithPath = sOutputFilePath & sOutputFileName & iCount & ".XML"
    ''Write the entire file to sText
        Open sOutputFileNamewithPath For Output As #nDestFile
        Print #nDestFile, sXML

        iRow = iRow + 1
        sXML = ""
        iCount = iCount + 1
    Wend
    'sXML = sXML & "</rows>"

    Close
End Sub
1
这与Sonata的答案相同 :-( - iDevlop
我认为VBA中的默认输出编码不是UTF-8。 - Wernfried Domscheit
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接