How to generate XML from Excel VBA macro?

Question

So, I have a bunch of content that was delivered to us in the form of Excel spreadsheets. I need to take this content and push it to another system. Another system takes its input from an XML file. I could do it all manually (and believe me, the manual has no problem forcing me to do this!), But I hope there is an easy way to write an Excel macro that will generate the XML I need. This seems like the best solution for me, because it is a job that needs to be repeated regularly (we will get a lot of content in Excel sheets), and it makes sense to have a batch tool that does this for us.

However, I have never experimented with generating XML from Excel tables before. I have a little knowledge of VBA, but I'm new to XML. I guess my problem with Googling is that I don’t even know what for Google. Can someone give me a little direction to get me started? Is my idea correct as an approach to this problem, or do I not see anything obvious?

Thanks StackOverflow!

Answer 1

For help, see Export Excel to XML in VBA .

Answer 2

Perhaps you should consider ADO - a worksheet or range can be used as a table.

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 3

Credit: curiousmind.jlion.com/exceltotextfile (Link no longer exists)

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 

Answer 4

This is another version - it 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