XML-RDBMS
This page contains information for importing XML into relational databases - using SQL, VBA-MSXML
SQL
OPENXML
This imports XML into tabular format
USE DatabaseName
GO
DECLARE @idoc int
DECLARE @xmldoc nvarchar(4000)
//define the XML document//
SET @xmldoc = '
<ROOT>
<elementName1 fieldname1='Value' fieldname2='Value'>
</ROOT>
'
//Load and parse XML document//
EXEC sp_xml_preparedocument @idoc OUTPUT, @xmldoc
//XML in tabular format//
SELECT * FROM OPENXML(@idoc, '/ROOT/elementName1', 0) WITH ( : 0,1 = attributes, 2 = elements
fieldname1 datatype '@fieldname1',
fieldname2 datatype) '@fieldname2')
//Clear XML document from memory//
EXEC sp_xml_removedocument @idoc
Code Examples
Read XML Schema using SOM
This code from Microsoft's Technical articles in MSDN library reads XML Schema using SOM, outputting Schema to Immediate window
Const XSDPATH As String = "C:\Users\Graham\Desktop\Records 2009.xsd"
Public Sub Import_records_XML_Schema()
' Item types:
Const SOMITEM_SCHEMA As Integer = 4 * 1024
Const SOMITEM_ATTRIBUTE As Integer = SOMITEM_SCHEMA + 1
Const SOMITEM_ATTRIBUTEGROUP As Integer = SOMITEM_SCHEMA + 2
Const SOMITEM_NOTATION As Integer = SOMITEM_SCHEMA + 3
Const SOMITEM_ANYTYPE As Integer = 8 * 1024
Const SOMITEM_DATATYPE As Integer = SOMITEM_ANYTYPE + 256
Const SOMITEM_SIMPLETYPE As Integer = SOMITEM_DATATYPE + 256
Const SOMITEM_COMPLEXTYPE As Integer = 9 * 1024
Const SOMITEM_PARTICLE As Integer = 16 * 1024
Const SOMITEM_ANY As Integer = SOMITEM_PARTICLE + 1
Const SOMITEM_ANYATTRIBUTE As Integer = SOMITEM_PARTICLE + 2
Const SOMITEM_ELEMENT As Integer = SOMITEM_PARTICLE + 3
Const SOMITEM_GROUP As Integer = SOMITEM_PARTICLE + 256
Const SOMITEM_ALL As Integer = SOMITEM_GROUP + 1
Const SOMITEM_CHOICE As Integer = SOMITEM_GROUP + 2
Const SOMITEM_SEQUENCE As Integer = SOMITEM_GROUP + 3
Const SOMITEM_EMPTYPARTICLE As Integer = SOMITEM_GROUP + 4
' Attribute uses
Const SCHEMAUSE_OPTIONAL As Integer = 0
Const SCHEMAUSE_PROHIBITED As Integer = 1
Const SCHEMAUSE_REQUIRED As Integer = 2
Const SCHEMACONTENTTYPE_EMPTY As Integer = 0
Const SCHEMACONTENTTYPE_TEXTONLY As Integer = 1
Const SCHEMACONTENTTYPE_ELEMENTONLY As Integer = 2
Const SCHEMACONTENTTYPE_MIXED As Integer = 3
Dim objSchemaCache As XMLSchemaCache60
Dim objSchema As ISchema
Dim objElement As ISchemaElement
Dim objArrtibutes As ISchemaAttribute
Dim objType As ISchemaType
Dim objSimpleType As ISchemaType
Dim objComplexType As ISchemaComplexType
Dim targetNameSpace As String
'GET FILENAME
targetNameSpace = "http://gcfrench/dataset"
'LobjAttributesD XML SCHEMA
Set objSchemaCache = New XMLSchemaCache60
objSchemaCache.Add targetNameSpace, XSDPATH
Set objSchema = objSchemaCache.getSchema(targetNameSpace)
remarks = 1
Result = "<xsd:schema xmlns:xsd='http://www.w3.org/2001/XMLSchema'>" + vbNewLine
For Each objElement In objSchema.elements
Result = Result + printElement(objElement, 0)
Next
For Each objAttributes In objSchema.Attributes
Result = Result + printAttr(objAttributes, t)
Next
Result = Result + vbNewLine
For Each objType In objSchema.types
Result = Result + processType(objType, 0)
Next
Result = Result + "</xsd:schema>"
Debug.Print Result
End Sub
' -------------------------------------------------------------------------------------------
Function processType(objType, t)
' res = printTab(t) + printRemark(objType.name)+ vbNewLine
If objType.itemType = SOMITEM_ANYTYPE Then
res = res + printTab(t + 1) + "<!-- " + objType.Name + " -->"
End If
If objType.itemType = SOMITEM_COMPLEXTYPE Then
res = res + processComplexType(objType, t + 1)
End If
If objType.itemType = SOMITEM_SIMPLETYPE Then
res = res + processSimpleType(objType, t + 1)
End If
processType = res + vbNewLine
End Function
Function processComplexType(oComplex, t)
res = printTab(t) + "<xsd:complexType"
If oComplex.Name <> "" Then
res = res + " name='" + oComplex.Name + "'"
End If
res = res + ">"
If oComplex.contentType = SCHEMACONTENTTYPE_EMPTY Then
res = res + printRemark("emtpy")
End If
If oComplex.contentType = SCHEMACONTENTTYPE_TEXTONLY Then
res = res + printRemark("textonly")
End If
If oComplex.contentType = SCHEMACONTENTTYPE_ELEMENTONLY Then
res = res + printRemark("elementonly")
res = res + processGroup(oComplex.contentModel, t + 1)
End If
If oComplex.contentType = SCHEMACONTENTTYPE_MIXED Then
res = res + printRemark("mixed")
res = res + processGroup(oComplex.contentModel, t + 1)
End If
res = res + vbNewLine
If oComplex.baseTypes.length > 0 Then
res = res + printRestrictions(oComplex, t + 1)
End If
On Error Resume Next
'Set any = oComplex.anyAttribute.name
If Err.Number = 0 Then
res = res + oComplex.anyAttribute.Name
End If
For Each objAttributes In oComplex.Attributes
res = res + printAttr(objAttributes, t + 1)
Next
processComplexType = res + printTab(t) + "</xsd:complexType>" + vbNewLine
End Function
Function processSimpleType(oSimple, t)
res = printTab(t) + "<xsd:simpleType"
If oSimple.Name <> "" Then
res = res + " name='" + oSimple.Name + "'"
End If
res = res + ">" + vbNewLine
If oSimple.baseTypes.length = 1 Then
res = res + printRestrictions(oSimple, t + 1)
Else
For Each objType In oSimple.baseTypes
res = res + "<baseType name='" + printName(objType) + "'>" + vbNewLine
Next
End If
processSimpleType = res + printTab(t) + "</xsd:simpleType>" + vbNewLine
End Function
Function processGroup(poGroup, t)
res = ""
' List elements in the sequence.
If poGroup.itemType = SOMITEM_ALL Then
res = res + printTab(t + 1) + "<xsd:all>" + vbNewLine
res = res + processChoiceOrSequence(poGroup, t + 1)
res = res + printTab(t + 1) + "</xsd:all>"
End If
If poGroup.itemType = SOMITEM_CHOICE Then
res = res + printTab(t + 1) + "<xsd:choice>" + vbNewLine
res = res + processChoiceOrSequence(poGroup, t + 1)
res = res + printTab(t + 1) + "</xsd:choice>"
End If
If poGroup.itemType = SOMITEM_SEQUENCE Then
res = res + printTab(t + 1) + "<xsd:sequence>" + vbNewLine
res = res + processChoiceOrSequence(poGroup, t + 1)
res = res + printTab(t + 1) + "</xsd:sequence>"
End If
processGroup = res
End Function
Function processChoiceOrSequence(poGroup, t)
res = ""
For Each item In poGroup.particles
If item.itemType = SOMITEM_ELEMENT Then
res = res + printElement(item, t + 1)
End If
If (item.itemType And SOMITEM_GROUP) = SOMITEM_GROUP Then
res = res + processGroup(item, t + 1) + vbNewLine
End If
If item.itemType = SOMITEM_ANY Then
res = res + "any: " + item.Name + vbNewLine
End If
Next
processChoiceOrSequence = res
End Function
Function printElement(objElement, t)
res = printTab(t) + "<xsd:element "
If objElement.isReference Then
res = res + "ref='" + objElement.Name + "'" + printParticles(objElement) + ">"
res = res + "<!-- "
res = res + " abstract='" & objElement.isAbstract & "'"
res = res + " -->"
Else
Set objType = objElement.Type
res = res + "name='" + objElement.Name + "'" + printParticles(objElement)
res = res + " abstract='" & objElement.isAbstract & "'"
res = res + " id='" & objElement.id & "'"
If objType.Name = "" Then
res = res + ">" + vbNewLine
If objType.itemType = SOMITEM_COMPLEXTYPE Then
res = res + printElement + processComplexType(objType, t + 1)
Else
res = res + processSimpleType(objType, t)
End If
res = res + printTab(t) + "</xsd:element>"
Else
If printName(objType) <> "xsd:anyType" Then
res = res + " type='" + printName(objType) + "'"
End If
If objType.itemType <> SOMITEM_COMPLEXTYPE Then
If objType.baseTypes.length = 0 Then
res = res + "/>"
Else
res = res + ">" + vbNewLine + processSimpleType(objType, t)
res = res + printTab(t) + "</xsd:element>"
End If
Else
res = res + "/>"
End If
End If
End If
If Not objElement.scope Is Nothing Then
strRem = "scope:" + printName(objElement.scope)
End If
res = res + printRemark(strRem)
printElement = res
End Function
Function printParticles(oParticle)
If oParticle.minOccurs <> 1 Then
res = res + " minOccurs='" & oParticle.minOccurs & "'"
End If
If oParticle.maxOccurs <> 1 Then
If oParticle.maxOccurs = -1 Then
res = res + " maxOccurs='unbounded'"
Else
res = res + " maxOccurs='" & oParticle.maxOccurs & "'"
End If
End If
printParticles = res
End Function
Function printAttr(objAttributes, t)
If objAttributes.isReference Then
printAttr = printAttr + printTab(t) + "<xsd:attribute ref='" + objAttributes.Name + "'"
Else
printAttr = printAttr + printTab(t) + "<xsd:attribute name='" + objAttributes.Name + "'"
End If
If objAttributes.Type.Name <> "" Then
printAttr = printAttr + " type='" + printName(objAttributes.Type) + "'"
End If
If objAttributes.DefaultValue <> "" Then
printAttr = printAttr + " default='" + objAttributes.DefaultValue + "'"
End If
If objAttributes.fixedValue <> "" Then
printAttr = printAttr + " fixed='" + objAttributes.fixedValue + "'"
End If
If objAttributes.use = SCHEMAUSE_OPTIONAL Then
printAttr = printAttr + " use='optional'"
End If
If objAttributes.use = SCHEMAUSE_PROHIBITED Then
printAttr = printAttr + " use='prohibited'"
End If
If objAttributes.use = SCHEMAUSE_REQUIRED Then
printAttr = printAttr + " use='required'"
End If
printAttr = printAttr + "/>"
If Not objAttributes.scope Is Nothing Then
strRem = "scope:" + printName(objAttributes.scope)
End If
printAttr = printAttr + printRemark(strRem)
End Function
Function printTab(t)
strTab = ""
For x = 0 To t
strTab = strTab + " "
Next
printTab = strTab
End Function
Function printName(item)
printName = ""
If (item.itemType And SOMITEM_DATATYPE) = SOMITEM_DATATYPE Then
printName = "xsd:"
End If
If item.itemType = SOMITEM_ANYTYPE Then
printName = "xsd:"
End If
printName = printName + item.Name
End Function
Function printRestrictions(objType, t)
res = ""
If objType.minExclusive <> "" Then
res = res + printTab(t + 1) + "<xsd:minExclusive value='" + objType.minExclusive + "'/>" + vbNewLine
End If
If objType.minInclusive <> "" Then
res = res + printTab(t + 1) + "<xsd:minInclusive value='" + objType.minInclusive + "'/>" + vbNewLine
End If
If objType.maxExclusive <> "" Then
res = res + printTab(t + 1) + "<xsd:maxExclusive value='" + objType.maxExclusive + "'/>" + vbNewLine
End If
If objType.maxInclusive <> "" Then
res = res + printTab(t + 1) + "<xsd:maxInclusive value='" + objType.maxInclusive + "'/>" + vbNewLine
End If
If objType.totalDigits > -1 Then
res = res + printTab(t + 1) + "<xsd:totalDigits value='" & objType.totalDigits & "'/>" + vbNewLine
End If
If objType.fractionDigits > -1 Then
res = res + printTab(t + 1) + "<xsd:fractionDigits value='" & objType.fractionDigits & "'/>" + vbNewLine
End If
If objType.length > -1 Then
res = res + printTab(t + 1) + "<xsd:length value='" & objType.length & "'/>" + vbNewLine
End If
If objType.minLength > -1 Then
res = res + printTab(t + 1) + "<xsd:minLength value='" & objType.minLength & "'/>" + vbNewLine
End If
If objType.maxLength > -1 Then
res = res + printTab(t + 1) + "<xsd:maxLength value='" & objType.maxLength & "'/>" + vbNewLine
End If
If objType.enumeration.length > 0 Then
For Each item In objType.enumeration
res = res + printTab(t + 1) + "<xsd:enumeration value='" + item + "'/>" + vbNewLine
Next
End If
If objType.whitespace > 0 Then
res = res + printTab(t + 1) + "<xsd:whitespace value='" & objType.whitespace & "'/>" + vbNewLine
End If
If objType.patterns.length <> 0 Then
For Each opattern In objType.patterns
res = res + printTab(t + 1) + "<xsd:pattern value='" + opattern + "'/>" + vbNewLine
Next
End If
printRestrictions = ""
If res <> "" And objType.baseTypes.length > 0 Then
printRestrictions = printRestrictions + printTab(t) + "<xsd:restriction base='" + printName(objType.baseTypes(0)) + "'>" + vbNewLine
printRestrictions = printRestrictions + res
printRestrictions = printRestrictions + printTab(t) + "</xsd:restriction>" + vbNewLine
End If
End Function
Function printRemark(r)
If remarks = 1 Then
printRemark = "<!-- " + r + " -->"
End If
printRemark = printRemark + vbNewLine
End Function
Create Tables from XML Schema
This code reads a XML schema and creates the corresponding tables in a Microsoft Access database
Public Sub Import_records_XML_Schema()
Dim objSchemaCache As XMLSchemaCache60
Dim objSchema As ISchema
Dim objtblElement, objfldsElement, objfldElement As ISchemaElement
Dim objtblType, objfldsType, objfldType As ISchemaType
Dim objtblComplexType, objfldsComplexType, objfldComplexType As ISchemaComplexType
Dim objtblParticle, objtfldsParticle, objfldParticle As ISchemaParticle
'DELETE TABLES
Set db = CurrentDb
On Error Resume Next
db.TableDefs.Delete ("Records " & thisYear)
db.TableDefs.Delete ("Sites")
On Error GoTo 0
'GET FILENAME
targetNameSpace = "http://gcfrench/dataset"
'LOAD XML SCHEMA
Set objSchemaCache = New XMLSchemaCache60
objSchemaCache.Add targetNameSpace, sFolderPath & "/Records " & thisYear & ".xsd"
Set objSchema = objSchemaCache.getSchema(targetNameSpace)
'GET TABLES
For Each objtblElement In objSchema.elements
Set objtblComplexType = objtblElement.Type
For Each objtblParticle In objtblComplexType.contentModel.particles
Set objtblElement = objtblParticle
'CREATE TABLE
Set tbl = db.CreateTableDef(objtblElement.Name)
Set objtblType = objtblElement.Type
'GET FIELDS
For Each objfldsType In objSchema.types
Set objfldsComplexType = objfldsType
For Each objfldsParticle In objfldsComplexType.contentModel.particles
Set objfldsElement = objfldsParticle
If objfldsElement.Name = objtblType.Name Then
Set objfldComplexType = objfldsElement.Type
For Each objfldParticle In objfldComplexType.contentModel.particles
Set objfldElement = objfldParticle
Set objfldType = objfldElement.Type
'CREATE FIELD
Select Case objfldType.Name
Case Is = "string"
Set fld = tbl.CreateField(Replace(objfldElement.Name, "_", " "), dbText)
fld.Size = 255
tbl.Fields.Append fld
Case Else
End Select
Next
db.TableDefs.Append tbl
End If
Next
Next
Next
Next
'TIDY UP TABLES
Set tbl = db.TableDefs("records")
tbl.Name = "Records " & thisYear
Set tbl = db.TableDefs("sites")
tbl.Name = "Sites"
Set fld = tbl.Fields("Item Name")
fld.Name = "ITEM_NAME"
db.TableDefs.Refresh
End Sub
SAX Reader
Recommendation
Parsers
Xerces - Apache: http://xml.apache.org/xerces-j
XP - James Clark: http://www.xmlmind.com/_xpforjaxp/docs/
Alfred2: http://www.gnu.org/software/classpathx/jaxp/
Crimson: http://xml.apache.org/crimson
Sun java API for XML: http://java.sun.com/xml
Oracle: http://otn.oracle.com/tech/xml/index.html
Examples
This code reads XML document with SAX, requiring associated content and error handler classes
Public Sub Import_records_XML_Data()
Dim reader As SAXXMLReader60
Dim contentHandler As clsSAXContentHandler
Dim errorHandler As clsSAXErrorHandler
'SET SAX READER
Set reader = New SAXXMLReader60
Set contentHandler = New clsSAXContentHandler
Set errorHandler = New clsSAXErrorHandler
Set reader.contentHandler = contentHandler
Set reader.errorHandler = errorHandler
'START SAX READER
reader.parseURL (FilePath.xml")
End Sub
SAX ContentHandler
This empty class handles the Content events fired by the SAX reader
Implements IVBSAXContentHandler
Private Sub IVBSAXContentHandler_startDocument()
End Sub
Private Sub IVBSAXContentHandler_startPrefixMapping(strPrefix As String, strURI As String)
End Sub
Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal oAttributes As MSXML2.IVBSAXAttributes)
End Sub
Private Sub IVBSAXContentHandler_characters(strChars As String)
End Sub
Private Property Set IVBSAXContentHandler_documentLocator(ByVal RHS As MSXML2.IVBSAXLocator)
End Property
Private Sub IVBSAXContentHandler_ignorableWhitespace(strChars As String)
End Sub
Private Sub IVBSAXContentHandler_processingInstruction(strTarget As String, strData As String)
End Sub
Private Sub IVBSAXContentHandler_skippedEntity(strName As String)
End Sub
Private Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, strLocalName As String, strQName As String)
End Sub
Private Sub IVBSAXContentHandler_endPrefixMapping(strPrefix As String)
End Sub
Private Sub IVBSAXContentHandler_endDocument()
End Sub
SAX ErrorHandler
This empty class handles the Error events fired by the SAX reader
Implements IVBSAXErrorHandler
Private Sub IVBSAXErrorHandler_ignorableWarning(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub
Private Sub IVBSAXErrorHandler_error(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub
Private Sub IVBSAXErrorHandler_fatalError(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub
page_revision: 33, last_edited: 1258227997|%e %b %Y, %H:%M %Z (%O ago)
