asked on
Private Sub cmdUploadXMLFile_Click()
Sheets("Sheet2").Select
Call XML
End Sub
Sub XML() '
' XML Macro
Call ExportToXML("H:\NRTEcho\ACTIVE\GROPER\eBillStatusChanges.xml", "Row")
End Sub
Public Function ExportToXML(FullPath As String, RowName _
As String) As Boolean
On Error GoTo ErrorHandler
Dim colIndex As Integer
Dim rwIndex As Integer
Dim asCols() As String
Dim oWorkSheet As Worksheet
Dim sName As String
Dim lCols As Long, lRows As Long
Dim iFileNum As Integer
Set oWorkSheet = ThisWorkbook.Worksheets(2)
sName = oWorkSheet.Name
lCols = oWorkSheet.Columns.Count
lRows = oWorkSheet.Rows.Count
ReDim asCols(lCols) As String
iFileNum = FreeFile
Open FullPath For Output As #iFileNum
For i = 0 To lCols - 1
'Assumes no blank column names
If Trim(Cells(1, i + 1).Value) = "" Then Exit For
asCols(i) = Cells(1, i + 1).Value
Next i
If i = 0 Then GoTo ErrorHandler
lCols = i
Print #iFileNum, "<?xml version=""1.0""?>"
Print #iFileNum, "<" & sName & ">"
For i = 2 To lRows
If Trim(Cells(i, 1).Value) = "" Then Exit For
Print #iFileNum, "<" & RowName & ">"
For j = 1 To lCols
If Trim(Cells(i, j).Value) <> "" Then
Print #iFileNum, " <" & asCols(j - 1) & "><![CDATA[";
Print #iFileNum, Trim(Cells(i, j).Value);
Print #iFileNum, "]]></" & asCols(j - 1) & ">"
DoEvents 'OPTIONAL
End If
Next j
Print #iFileNum, " </" & RowName & ">"
Next i
Print #iFileNum, "</" & sName & ">"
ExportToXML = True
ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
Exit Function
End Function