如何从 Excel VBA 宏生成 XML？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/2766760/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to generate XML from an Excel VBA macro?
提问by SuperNES
So, I've got a bunch of content that was delivered to us in the form of Excel spreadsheets. I need to take that content and push it into another system. The other system takes its input from an XML file. I could do all of this by hand (and trust me, management has no problem making me do that!), but I'm hoping there's an easy way to write an Excel macro that would generate the XML I need instead. This seems like a better solution to me, as this is a job that will need to be repeated regularly (we'll be getting a LOT of content in Excel sheets) and it just makes sense to have a batch tool that does it for us.
所以，我有一堆以 Excel 电子表格形式提供给我们的内容。我需要获取该内容并将其推送到另一个系统中。另一个系统从 XML 文件获取其输入。我可以手动完成所有这些（相信我，管理层让我这样做是没有问题的！），但我希望有一种简单的方法来编写 Excel 宏来生成我需要的 XML。这对我来说似乎是一个更好的解决方案，因为这是一项需要定期重复的工作（我们将在 Excel 工作表中获得大量内容），并且有一个批处理工具为我们做这件事才有意义.
However, I've never experimented with generating XML from Excel spreadsheets before. I have a little VBA knowledge but I'm a newbie to XML. I guess my problem in Googling this is that I don't even know what to Google for. Can anyone give me a little direction to get me started? Does my idea sound like the right way to approach this problem, or am I overlooking something obvious?
但是，我以前从未尝试过从 Excel 电子表格生成 XML。我有一点 VBA 知识，但我是 XML 的新手。我想我在谷歌上的问题是我什至不知道谷歌是为了什么。谁能给我一点指导让我开始？我的想法听起来像是解决这个问题的正确方法，还是我忽略了一些明显的东西？
Thanks StackOverflow!
感谢 StackOverflow！
采纳答案by Galwegian
See Export Excel to XML in VBAfor help.
有关帮助，请参阅在 VBA 中将 Excel 导出为 XML。
回答by Fionnuala
You might like to consider ADO - a worksheet or range can be used as a table.
您可能想考虑 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
回答by Solata
Credit to: curiousmind.jlion.com/exceltotextfile (Link no longer exists)
归功于：curiousmind.jlion.com/exceltotextfile（链接不再存在）
Script:
脚本：
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
回答by Bhaghawadgeetha Sundaram
This one more version - this will help in generic
这又是一个版本 - 这将有助于通用
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
