8

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.

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?

Thanks StackOverflow!

Improve this question

4 Answers 4

Reset to default
8

You might like to 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 ''strFile = ActiveWorkbook.FullName 'use this if using active workbook ''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"";" ''use this if you are on M365 Excel (above returned error for me), below worked. 'strCon = "Provider=Microsoft.ACE.OLEDB.12.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

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

strFile = ActiveWorkbook.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.ACE.OLEDB.12.0;Data Source=" & strFile _ & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

Improve this answer
Sign up to request clarification or add additional context in comments.

2 Comments

This beats using a loop for 200,000 rows +1 :)
@Fionnuala Thanks a lot. I am using windows 10 64 Bit and I have installed oledb from this link https://learn.microsoft.com/en-us/sql/connect/oledb/download-oledb-driver-for-sql-server?view=sql-server-2017 ..But I got error at this line cn.Open strCon .. It seems that it is the Provider so I used Provider=MSOLEDBSQL .. But I got error at the next line Invalid connection string attribute
4

Credit to: 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
Improve this answer

3 Comments

I don't think the default output encoding in VBA is UTF-8
What happens if your data in Excel contains characters like < or >? The file will become not well formed.
This is true. We have two options: 1. handle unsupported chars, when text is entered in Excel or 2. encode chars, when generating XML.
0

Here is the example macro to convert the Excel worksheet to XML file.

#'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

This macro will open an existing Excel workbook from the C drive and Convert the file into XML and Save the file with .xml extension in the specified Folder. We are using Workbook Open method to open a file. SaveAs method to Save the file into destination folder. This example will be help full, if you wan to convert all excel files in a directory into XML (xlXMLSpreadsheet format) file.

Improve this answer

Comments

-3

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
Improve this answer

2 Comments

it's the same as Sonata's answer :-(
I don't think the default output encoding in VBA is UTF-8

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.