Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)
- Dim Q As String
- Dim NodeName As String
- Dim AtributName As String
- Application.ScreenUpdating = False
- Q = Chr$(34)
- Dim sXML As String
- sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
- sXML = sXML & "<root>"
- NodeName = "node"
- AtributName = "test"
- ''--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 & "<" & NodeName & " type=" & Q & AtributName & Q & " 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 & "</" & NodeName & ">"
- iRow = iRow + 1
- Wend
- sXML = sXML & "</root>"
- 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
- Application.ScreenUpdating = True
- End Sub
- Sub ExcelToXml()
- Dim FileName As String
- FileName = InputBox("Dateinamen eingeben:")
- Call MakeXML(1, 2, ActiveWorkbook.Path & "" & FileName & ".xml")
- End Sub
- Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)
- Dim Q As String
- Dim NodeName As String
- Dim AtributName As String
- Dim fso As Object
- Set fso = CreateObject("Scripting.FileSystemObject")
- Dim oFile As Object
- Set oFile = fso.CreateTextFile(sOutputFileName)
- Application.ScreenUpdating = False
- Q = Chr$(34)
- oFile.Write "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
- oFile.Write "<root>"
- NodeName = "node"
- AtributName = "test"
- ''--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) > ""
- oFile.Write "<" & NodeName & " type=" & Q & AtributName & Q & " id=" & Q & iRow & Q & ">"
- For icol = 1 To iColCount - 1
- oFile.Write "<" & Trim$(Cells(iCaptionRow, icol)) & ">"
- oFile.Write Trim$(Cells(iRow, icol))
- oFile.Write "</" & Trim$(Cells(iCaptionRow, icol)) & ">"
- Next
- oFile.Write "</" & NodeName & ">"
- iRow = iRow + 1
- Wend
- oFile.Write "</root>"
- oFile.Close
- Application.ScreenUpdating = True
- End Sub
Add Comment
Please, Sign In to add comment