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

Answer 3

请参阅Export Excel to XML in VBA寻求帮助。

Answer 4

这是将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的文件保存在指定的Folder中。我们正在使用Workbook Open方法打开文件。 SaveAs方法将文件保存到目标文件夹。如果您希望将目录中的所有excel文件转换为XML（xlXMLSpreadsheet格式）文件，此示例将为您提供全面的帮助。

Answer 5

这还有一个版本 - 这将有助于通用

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

如何从Excel VBA宏生成XML？

5 个答案: