MartyConnelly
martyconnelly at shaw.ca
Fri Jul 1 18:35:06 CDT 2005
Ok, here is some code to get you started it reads a northwind table
and outputs three types of files
XML Flat file format just elements plus initial XML PI
XML ADTG format ( the type with zRows schema) suitable to be read
directly back into an mdb
CSV file
Where you want to change this code is where I load the northwind SQL
recordset.
Replace it by what you have returned from XMLHTTP by oDOM.loadXML
(objXMLHTTP.responseXML.xml)
What you are getting returned in response object is just one long xml
string.
Application.ExportXML won't work here as it has to be an Access Object
to be output.
You might also want to use .validateonparse method to error check the
xml you are getting initally.
If you wanted to once you have your returned xml in the dom you could
use Xpath
to grab specific fields.
Sub readmdb()
Dim sSQL As String
Dim iNumRecords As Integer
Dim oConnection As ADODB.Connection
Dim oRecordset As ADODB.Recordset
Dim rstSchema As ADODB.Recordset
Dim sConnStr As String
'sConnStr = "Provider=SQLOLEDB;Data Source=MySrvr;" & _
"Initial Catalog=Northwind;User Id=MyId;Password=123aBc;"
' Connection "Provider=Microsoft.Jet.OLEDB.3.51;Data
Source=D:\DataBases\Northwind.mdb"
'Access 97 version Jet 3.51
' sConnStr = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=C:\Program Files\Microsoft
Office\Office\Samples\Northwind.mdb;" & _
"User Id=admin;" & "Password="
'Access XP Jet 4
sConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Program Files\Microsoft
Office\Office\Samples\Northwind.mdb;" & _
"User Id=admin;" & "Password="
'On Error GoTo GetDataError
' Create and Open the Connection object.
Set oConnection = New ADODB.Connection
oConnection.CursorLocation = adUseClient
oConnection.Open sConnStr
sSQL = "SELECT ProductID, ProductName, CategoryID, UnitPrice " & _
"FROM Products"
' Create and Open the Recordset object.
Set oRecordset = New ADODB.Recordset
oRecordset.Open sSQL, oConnection, adOpenStatic, _
adLockBatchOptimistic, adCmdText
With oRecordset
Debug.Print .RecordCount
Dim i As Long
Dim strOut As String
strOut = ""
.MoveFirst
For i = 0 To .RecordCount - 1
strOut = strOut & !ProductName
strOut = strOut & "," & !CategoryID
strOut = strOut & "," & !UnitPrice
strOut = strOut & vbCrLf
.MoveNext
Next i
End With
'Save as Access csv file
WriteFile "C:\Access files\xmlfiles\strout" & Format(Now,
"yyyymmddhhmmss") & ".xml", strOut
Dim oDOM As MSXML2.DOMDocument
Dim oXML As MSXML2.DOMDocument
Dim oXSL As MSXML2.DOMDocument
Dim strHTML As String
Dim strTransform As String
Set oDOM = CreateObject("MSXML2.DOMDocument")
oDOM.async = False
'Load the XML DOM
'Put recordset into XML Dom
' Here you would load your xml string
' read from whatever is returned by xmlhttp or xnlhttpserver into the
XML DOM
' I forget if it is objXMLHTTP.responseXML.xml or objXMLHTTP.responseXML
' Set objXMLHTTP = New MSXML2.XMLHTTP
' Debug.Print "returned=" & objXMLHTTP.responseXML.xml
' oDOM.loadXML (objXMLHTTP.responseXML.xml)
' in place of line below
oRecordset.Save oDOM, adPersistXML '1 magic number
Set oXSL = CreateObject("MSXML2.DOMDocument")
oXSL.async = False
oXSL.Load "C:\Access files\xmlfiles\ADOGeneric.xsl" 'your XSLT
stylesheet save as unicode not ansii
'note encoding as european language encoding need for swedish characters
'you could scan the the string and convert to unicode escape characters
like '
strTransform = oDOM.transformNode(oXSL)
strHTML = "<?xml version='1.0' encoding=""ISO-8859-1""?>" & vbCrLf & _
"<root>" & strTransform & "</root>"
'Save as flat xml file
WriteFile "C:\Access files\xmlfiles\ADOGenericProduct" & Format(Now,
"yyyymmddhhmmss") & ".xml", strHTML
'
'the above XSLT transform with xsl file converts this to a flat XML
format without rowset schema
'this will save to an XML file with ADTG MS Format suitable to dump
back into table or recordset
oRecordset.Save "C:\Access files\xmlfiles\ADOGenericProductADG.xml",
adPersistXML
Set oDOM = Nothing
Set oXML = Nothing
Set oXSL = Nothing
Set oConnection = Nothing
Set oRecordset = Nothing
End Sub
Public Sub WriteFile(ByVal sFileName As String, ByVal sContents As String)
' Dump XML String to File for debugging
Dim fhFile As Integer
fhFile = FreeFile
' Debug.Print "Length of string=" & Len(sContents)
Open sFileName For Output As #fhFile
Print #fhFile, sContents;
Close #fhFile
Debug.Print "Out File" & sFileName
End Sub
ADOgeneric.xsl file cut and paste and save in notepad as Unicode not Ansi
This is XSLT file that strips all the extraneous rowset schema from ADTG
formated xml file to create flat xml
<?xml version='1.0'?>
<xsl:stylesheet version="1.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882" xmlns:z="#RowsetSchema">
<s:Schema id="RowsetSchema"/>
<xsl:output method="xml" omit-xml-declaration="yes" />
<xsl:template match="/">
<xsl:apply-templates select="//z:row"/>
</xsl:template>
<xsl:template match="z:row">
<xsl:text disable-output-escaping="yes"><row></xsl:text>
<xsl:for-each select="@*">
<xsl:text disable-output-escaping="yes"><</xsl:text>
<xsl:value-of select="name()"/>
<xsl:text disable-output-escaping="yes">></xsl:text>
<xsl:value-of select="."/>
<xsl:text disable-output-escaping="yes"></</xsl:text>
<xsl:value-of select="name()"/>
<xsl:text disable-output-escaping="yes">></xsl:text>
</xsl:for-each>
<xsl:text disable-output-escaping="yes"></row></xsl:text>
</xsl:template>
</xsl:stylesheet>
Francisco Tapia wrote:
>Ok, so I have a webservices that returns an XML reocordset. I'd like
>to save that recordset w/ ado to an XML file... anybody have any
>samples?
>
>
>
>
>
--
Marty Connelly
Victoria, B.C.
Canada