• Home
 · 
• Miscellaneous
 · 
• Builds XML File from an Excel Workbook.

Builds XML File from an Excel Workbook.

Builds XML File from an Excel Workbook.

Rate Builds XML File from an Excel Workbook.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    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