RDBMS-XML

This page contains information for exporting relational data in to XML - using SQL, VBA-MSXML

SQL

These export XML from tabular format

RAW

SELECT one.fieldname1, two.fieldname2 FROM table1 one
INNER JOIN table2 two ON one.fieldid = two.fieldid
FOR XML RAW, ROOT ('ROOTELEMENTNAME') , XMLSCHEMA, TYPE

<root>
  <!-- XML SCHEMA HERE -->
  <row fieldname1="Value" fieldname2="Value" />
<root>

---

AUTO

SELECT one.fieldname1, two.fieldname2 FROM table1 one
INNER JOIN table2 two ON one.fieldid = two.fieldid
FOR XML AUTO

<one fieldname1="Value">
    <two fieldname2="Value" />
</one>

.... FOR XML AUTO, ELEMENTS
<one>
   <fieldname1>"Value"</fieldname1>
    <two>
      <fieldname2>"Value"</fieldname2>
    </two>
</one>

---

EXPLICIT

SELECT 1  AS Tag,
 NULL AS Parent,
 table1.fieldname1 AS [ElementName1!1!fieldname1]
 NULL AS [ElementName2!2!fieldname2]
FROM table1

UNION ALL

SELECT 2,
  1,
  table1.fieldname1
  table2.fieldname2
FROM table1
INNER JOIN table2 ON table1.fieldid = table1.fieldid
ORDER BY [ElementName1!1!fieldname1]
FOR XML EXPLICIT

<ElementName1 fieldname1="Value">
   <ElementName2 fieldname2="Value" />
<ElementName1>

...... [ElementName2!2!fieldname2!element]
<ElementName1 fieldname1="Value">
   <ElementName2>
      <fieldname2>"Value"</fieldname2>
   </ElementName2>
<ElementName1>

...... [ElementName2!2!fieldname2!hide]
<ElementName1 fieldname1="Value">
   <ElementName2 />
<ElementName1>

...... [ElementName1!1!fieldname1!id]
       [ElementName2!2!fieldname2!idref]]
FOR XML EXPLICIT, XMLDATA
<ElementName1 fieldname1="Value">
   <ElementName2 fieldname2="Value" field="Value" />
<ElementName1>

...... [ElementName2!2!fieldname2!cdata]
<ElementName1 fieldname1="Value">
   <ElementName2 fieldname2="![CDATA["Value"]]" />
<ElementName1>

---

PATH

SELECT one.fieldname1, two.fieldname2 FROM table1 one
INNER JOIN table2 two ON one.fieldid = two.fieldid
FOR XML PATH

<row>
  <fieldname1>"Value"</fieldname1>
  <fieldname2>"Value"</fieldname2>
</row>

...... SELECT one.fieldname1 AS "@elementname" ... 
<row elementname="Value">
  <fieldname2>"Value"</fieldname2>
</row>

...... SELECT two.fieldname2 AS "elementname/@attributename", one.fieldname1 as elementname ... 
<row>
  <elementname attributename="Value2">"Value1"</elementname>
</row>

---

Code Examples

Create XML Schema using VBA, MSXML and DOM

This example generates an XML Schema from first row of 2 excel spreadsheets, using XMLDOMDocument6.0 with XMLWriter adding the XML Declaration using the SAXReader

Const XSDPATH = "C:\Users\Graham\Desktop\dataset.xsd"

Dim objXML As DOMDocument60
Dim objrootElement As IXMLDOMElement
Dim objnewElement As IXMLDOMElement
Dim objcurElement As IXMLDOMElement
Dim objAttribute As IXMLDOMAttribute
Dim objCDATA As IXMLDOMCDATASection
Dim objWrt As MXXMLWriter60
Dim objRdr As SAXXMLReader60

Public Sub Generate_XML_schema(Saved_path As String, Saved_name As String)

Dim wks As Worksheet
Dim colRange As Range
Dim iColumn As Integer
Dim arrColRange As Variant
Dim c As Integer

'GET HEADER COLUMNS FOR RECORDS
Set wks = Worksheets("Recorded_Data")
wks.Select
wks.Range("A1").Name = "topleftcellsh1"
Range("topleftcellsh1").Select
Set colRange = Range(ActiveCell, ActiveCell.End(xlToRight))
With colRange
  iColumn = .Columns.Count
End With
ReDim arrColRange(1, iColumn) As Variant
arrColRange = colRange.Value

'GENERATE DATA SCHEMA FOR RECORDS
Set objXML = New DOMDocument60
Set objrootElement = objXML.createNode(1, "xs:schema", "http://www.w3.org/2001/XMLSchema")
objrootElement.setAttribute "xmlns", "http://gcfrench/dataset"
objrootElement.setAttribute "targetNamespace", "http://gcfrench/dataset"
objrootElement.setAttribute "elementFormDefault", "qualified"
objrootElement.setAttribute "attributeFormDefault", "unqualified"
objrootElement.setAttribute "version", "1.0"
objXML.appendChild objrootElement

Set objnewElement = objXML.createElement("xs:element")
objnewElement.setAttribute "name", "dataset"
objrootElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:complexType")
Set objcurElement = objrootElement.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:sequence")
Set objcurElement = objrootElement.LastChild.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:element")
objnewElement.setAttribute "name", "records"
objnewElement.setAttribute "type", "record"
Set objcurElement = objrootElement.LastChild.LastChild.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:element")
objnewElement.setAttribute "name", "sites"
objnewElement.setAttribute "type", "site"
Set objcurElement = objrootElement.LastChild.LastChild.LastChild
objcurElement.appendChild objnewElement

'RECORD COMPLEXTYPE
Set objnewElement = objXML.createElement("xs:complexType")
objnewElement.setAttribute "name", "record"
objrootElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:sequence")
Set objcurElement = objrootElement.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:element")
objnewElement.setAttribute "name", "record"
objnewElement.setAttribute "maxOccurs", "unbounded"
Set objcurElement = objrootElement.LastChild.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:complexType")
Set objcurElement = objrootElement.LastChild.LastChild.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:sequence")
Set objcurElement = objrootElement.LastChild.LastChild.LastChild.LastChild
objcurElement.appendChild objnewElement

For c = 1 To iColumn
  Set objnewElement = objXML.createElement("xs:element")
  objnewElement.setAttribute "name", Replace(colRange(c), " ", "_")
  objnewElement.setAttribute "type", "xs:string"
  Set objcurElement = objrootElement.LastChild.LastChild.LastChild.LastChild.LastChild
  objcurElement.appendChild objnewElement
Next

'GET HEADER COLUMNS FOR SITES
Set wks = Worksheets("Location")
wks.Select
wks.Range("A1").Name = "topleftcellsh2"
Range("topleftcellsh2").Select
Set colRange = Range(ActiveCell, ActiveCell.End(xlToRight))
With colRange
  iColumn = .Columns.Count
End With
ReDim arrColRange(1, iColumn) As Variant
arrColRange = colRange.Value

'SITE COMPLEXTYPE
Set objnewElement = objXML.createElement("xs:complexType")
objnewElement.setAttribute "name", "site"
objrootElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:sequence")
Set objcurElement = objrootElement.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:element")
objnewElement.setAttribute "name", "site"
objnewElement.setAttribute "maxOccurs", "unbounded"
Set objcurElement = objrootElement.LastChild.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:complexType")
Set objcurElement = objrootElement.LastChild.LastChild.LastChild
objcurElement.appendChild objnewElement

Set objnewElement = objXML.createElement("xs:sequence")
Set objcurElement = objrootElement.LastChild.LastChild.LastChild.LastChild
objcurElement.appendChild objnewElement

For c = 1 To iColumn
  Set objnewElement = objXML.createElement("xs:element")
  objnewElement.setAttribute "name", Replace(colRange(c), " ", "_")
  objnewElement.setAttribute "type", "xs:string"
  Set objcurElement = objrootElement.LastChild.LastChild.LastChild.LastChild.LastChild
  objcurElement.appendChild objnewElement
Next

'ADD XML DECLARATION
Set objWrt = New MXXMLWriter60
objWrt.omitXMLDeclaration = False
objWrt.Encoding = "UTF-8"
objWrt.byteOrderMark = True
objWrt.standalone = True
objWrt.Version = "1.0"
objWrt.indent = True

'SET XML WRITER TO SAX CONTENT HANDLER
Set objRdr = New SAXXMLReader60
Set objRdr.contentHandler = objWrt

'PARSE XML DOCUMENT THROUGH SAX HANDLER
objRdr.Parse objXML

'OUTPUT XML WRITER
Open XSDPATH For Output As #1
Print #1, objWrt.output
Close #1

Erase arrColRange

End Sub

Create XML Document using VBA, MSXML and DOM

This example generates an XML document from first row of 2 excel spreadsheets, using XMLDOMDocument6.0 with XMLWriter adding the XML Declaration using the SAXReader

Const XMLPATH = "C:\Users\Graham\Desktop\dataset.xml"

Dim objXML As DOMDocument60
Dim objrootElement As IXMLDOMElement
Dim objnewElement As IXMLDOMElement
Dim objcurElement As IXMLDOMElement
Dim objAttribute As IXMLDOMAttribute
Dim objCDATA As IXMLDOMCDATASection
Dim objWrt As MXXMLWriter60
Dim objRdr As SAXXMLReader60

Public Sub Generate_XML_Document()

Dim wks As Worksheet
Dim rng As Range
Dim iColumn, irow  As Integer
Dim arrRange As Variant
Dim c, r As Integer

'GET DATA WITH HEADER COLUMNS
Set wks = Worksheets("sheet1")
wks.Select
wks.Range("A1").Name = "topleftcellsh1"
Range("topleftcellsh1").Select
Set rng = Range("topleftcellsh1").CurrentRegion
With rng
    iColumn = .Columns.Count
    irow = .Rows.Count
End With
ReDim arrRange(irow, iColumn) As Variant
arrRange = rng.Value

'GENERATE XML DOCUMENT FOR RECORDS
Set objXML = New DOMDocument60
Set objrootElement = objXML.createNode(1, "d:dataset", "http://gcfrench/dataset")
objrootElement.setAttribute "xmlns:xsi", "xmlns:xsi=http://www.w3.org/2001/XMLSchema-instance"
objrootElement.setAttribute "xsi:schemalocation", "http://gcfrench/dataset dataset.xsd"
objXML.appendChild objrootElement

Set objnewElement = objXML.createElement("d:records")
objrootElement.appendChild objnewElement

For r = 2 To irow

    Set objnewElement = objXML.createElement("d:record")
    Set objcurElement = objrootElement.LastChild
    objcurElement.appendChild objnewElement

    For c = 1 To iColumn
       If arrRange(r, c) <> "" Then
            Set objnewElement = objXML.createElement("d:" & Replace(arrRange(1, c), " ", "_"))
            Set objcurElement = objrootElement.LastChild.LastChild

            Select Case arrRange(1, c)
                Case Is = "Recorder", "Determiner", "Locality", "Comment"
                    Set objCDATA = objXML.createCDATASection(LTrim(arrRange(r, c)))
                    objnewElement.appendChild objCDATA
                Case Else
                objnewElement.Text = LTrim(arrRange(r, c))
            End Select
            objcurElement.appendChild objnewElement
        End If
    Next
Next

'GET SITES WITH HEADER COLUMNS
Set wks = Worksheets("sheet2")
wks.Select
wks.Range("A1").Name = "topleftcellsh2"
Range("topleftcellsh2").Select
Set rng = Range("topleftcellsh2").CurrentRegion
With rng
    iColumn = .Columns.Count
    irow = .Rows.Count
End With
ReDim arrRange(irow, iColumn) As Variant
arrRange = rng.Value

'ADD SITES TO XML DOCUMENT
Set objnewElement = objXML.createElement("d:sites")
objrootElement.appendChild objnewElement

For r = 2 To irow

    Set objnewElement = objXML.createElement("d:site")
    Set objcurElement = objrootElement.LastChild
    objcurElement.appendChild objnewElement

    For c = 1 To iColumn
       If arrRange(r, c) <> "" Then
            Set objnewElement = objXML.createElement("d:" & Replace(arrRange(1, c), " ", "_"))
            Set objcurElement = objrootElement.LastChild.LastChild

            Select Case arrRange(1, c)
                Case Is = "ITEM_NAME", "Site Type"
                    Set objCDATA = objXML.createCDATASection(LTrim(arrRange(r, c)))
                    objnewElement.appendChild objCDATA
                Case Else
                objnewElement.Text = LTrim(arrRange(r, c))
            End Select
            objcurElement.appendChild objnewElement
        End If
    Next
Next

'ADD XML DECLARATION
Set objWrt = New MXXMLWriter60
objWrt.omitXMLDeclaration = False
objWrt.Encoding = "UTF-8"
objWrt.byteOrderMark = True
objWrt.standalone = True
objWrt.Version = "1.0"
objWrt.indent = True

'SET XML WRITER TO SAX CONTENT HANDLER
Set objRdr = New SAXXMLReader60
Set objRdr.contentHandler = objWrt

'PARSE XML DOCUMENT THROUGH SAX HANDLER
objRdr.Parse objXML

'OUTPUT XML WRITER
Open XMLPATH For Output As #1
Print #1, objWrt.output
Close #1

'objXML.Save (XMLPATH)

Erase arrRange

'GO BACK TO SHEET 1
Set wks = Worksheets("sheet1")
wks.Select
Range("topleftcellsh1").Select

End Sub