by Rone (9 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 14th May 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Builds XML File from an Excel Workbook.
VBcoders
Dim xmldoc As MSXML2.DOMDocument
Dim xmLstring As String
Dim rowCntr As Integer
Dim colCntr As Integer
Dim fileLoc As String
Dim cmdlg As New CommonDialog
Dim strQuote As String
xmLstring = ""
rowCntr = 0
colCntr = 0
strQuote = """"
Set xmldoc = CreateObject("Microsoft.XMLDOM")
'Create Parent Node and add it to the string
xmLstring = "<FORM Name=" & strQuote & Range("Audit_Form").Value & strQuote & "> "
'-----------------------
'CATEGORIES
'-----------------------
rowCntr = 8
colCntr = 1
Do While Worksheets("Categories").Cells(rowCntr, 1).Value <> ""
'Add Item
xmLstring = xmLstring & "<CATEGORY "
For colCntr = 1 To 6 'There are only 6 columns
Select Case colCntr
Case 1 ' Category ID
xmLstring = xmLstring & "Id=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
Case 2 ' Parent Category
xmLstring = xmLstring & "Parent=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
Case 3 'Category Name
xmLstring = xmLstring & "Name=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
Case 4 'View Type
xmLstring = xmLstring & "Type=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
Case 5 ' Category Answer
xmLstring = xmLstring & "Answer=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
Case 6 'ReAudit
xmLstring = xmLstring & "Reaudit=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
End Select
Next
'Close the Item Tag
xmLstring = xmLstring & "></CATEGORY>"
'Move the counter to the next row
rowCntr = rowCntr + 1
Loop
'Add the closing to the Parent Node
xmLstring = xmLstring & "</FORM>"
'Load it so it can be saved
xmldoc.loadXML xmLstring
'obtain file location
cmdlg.ShowSave
fileLoc = cmdlg.Filename
'Save the file as XML
xmldoc.Save (fileLoc)
'Display successful save
ActiveSheet.Hyperlinks.Add Anchor:=Cells(10, 2), Address:=fileLoc _
, TextToDisplay:= _
"File saved successfuly at: " & fileLoc
End Sub
