Exporting XML file

**global_zoo** · 08-28-2012, 11:14 AM

Hi All,

I've created an Excel file from one provided by a client. It now has 23 columns and 1000s of rows. I'm looking to generate a XML file but have limited knowledge.

I made a simple XML schema (attached) which allows me to export the file correctly. In so doing each row becomes a parent (in my case, <item>) of the root (<items>). In this way, all the rows are listed as <item> and are bound at the start and end of the file by <items>.

As I'm using the XML file for a complicated book layout, I now need to group every 10 rows into a parent element. For example:

<items>
<item>1</item>
...
<item>10</item>
</items>
<item>
<item>11</item>
...
<item>20</item>
</items>

I believe this should be easy but I have already wasted hours trying to work it out... I'd appreciate any help!

Thanks

**mike7952** · 08-28-2012, 01:00 PM

Give this a try

Option Explicit
Function ColumnNumberToLetters(ColumnNumber As Long) As String
    Dim strLetters As String
    strLetters = Cells(1, ColumnNumber).Address(1, 0)
    ColumnNumberToLetters = Left(strLetters, InStr(1, strLetters, "$") - 1)
End Function
Sub ExportToXML()
On Error GoTo ErrorHandler
Const sFullPathName As String = "C:\Users\Mike\Desktop\text.xml"
Const shName As String = "Sheet1"
Const sTableName As String = "Items"
Const RowName As String = "Item"
Dim oWorkSheet As Worksheet
Dim lCols As Long, lRows As Long, i As Long, j As Long
Dim iFileNum As Integer
Dim str As String

    Set oWorkSheet = ThisWorkbook.Worksheets(shName)
    iFileNum = FreeFile
    Open sFullPathName For Output As #iFileNum
    Print #iFileNum, "<?xml version=""1.0"" encoding=""utf-8""?>"
    Print #iFileNum, "<" & sTableName & ">"
    With oWorkSheet
        lRows = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lCols = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        For i = 2 To lRows
        Print #iFileNum, vbTab & "<" & RowName & ">"
            For j = 1 To lCols
                str = ColumnNumberToLetters(j)
                If Trim(.Cells(i, j).Value) <> "" Then
                   Print #iFileNum, vbTab & vbTab & "<" & str & ">";
                   Print #iFileNum, Trim(.Cells(i, j).Value);
                   Print #iFileNum, "</" & str & ">"
                End If
            Next j
            Print #iFileNum, vbTab & "</" & RowName & ">"
        Next i
    End With
    Print #iFileNum, "</" & sTableName & ">"
    Set oWorkSheet = Nothing
ErrorHandler:
    If iFileNum > 0 Then Close #iFileNum
    Exit Sub
End Sub

**mike7952** · 08-28-2012, 01:41 PM

I missed the part about Groups of 10 so try this

Function ColumnNumberToLetters(ColumnNumber As Long) As String
    Dim strLetters As String
    strLetters = Cells(1, ColumnNumber).Address(1, 0)
    ColumnNumberToLetters = Left(strLetters, InStr(1, strLetters, "$") - 1)
End Function


Private Sub ExportToXML()
On Error GoTo ErrorHandler
Const sFullPathName As String = "C:\Users\Mike\Desktop\text.xml"
Const shName As String = "6pm"
Const sTableName As String = "Items"
Const RowName As String = "Item"
Dim oWorkSheet As Worksheet
Dim lCols As Long, lRows As Long, i As Long, j As Long
Dim iFileNum As Integer
Dim str As String
Dim iMod As Long
    Set oWorkSheet = ThisWorkbook.Worksheets(shName)
    iFileNum = FreeFile
    Open sFullPathName For Output As #iFileNum
    Print #iFileNum, "<?xml version=""1.0"" encoding=""utf-8""?>"
    Print #iFileNum, "<" & sTableName & ">"
    With oWorkSheet
        lRows = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lCols = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        For i = 1 To lRows
        
        If iMod = 10 Then
            Print #iFileNum, "</" & sTableName & ">"
            Print #iFileNum, "<" & sTableName & ">"
            iMod = 0
        End If
        iMod = iMod + 1
        
        Print #iFileNum, vbTab & "<" & RowName & ">"
            For j = 1 To lCols
                str = ColumnNumberToLetters(j)
                If Trim(.Cells(i, j).Value) <> "" Then
                   Print #iFileNum, vbTab & vbTab & "<" & str & ">";
                   Print #iFileNum, Trim(.Cells(i, j).Value);
                   Print #iFileNum, "</" & str & ">"
                End If
            Next j
            Print #iFileNum, vbTab & "</" & RowName & ">"
        Next i
    End With
    Print #iFileNum, "</" & sTableName & ">"
    Set oWorkSheet = Nothing
ErrorHandler:
    If iFileNum > 0 Then Close #iFileNum
    Exit Sub
End Sub