Snasui Excel Forum

Code: Select all

Sub Button1_Click()

Dim TheText
Dim TheLineText
TheText = "<?xml version=""1.0""?><product>"
For i = 3 To 10000
If Sheet1.Cells(i, 2) <> "" Then
TheLineText = "<p"
For j = 1 To 15
theCell = Sheet1.Cells(i, j)
theCell = Replace(theCell, "<", "<")
theCell = Replace(theCell, """", """)
theCell = Replace(theCell, ">", ">")
theCell = Replace(theCell, "&", "&")

TheLineText = TheLineText & " C" & j & "=""" & theCell & """"
Next
TheLineText = TheLineText & "></p>"
TheText = TheText & TheLineText
Else
Exit For
End If

Next
TheText = TheText & "</product>"


TheFilePath = Application.ActiveWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(TheFilePath & "\Product.xml", True)
a.WriteLine (TheText)
a.Close

End Sub