Yep, I know access has the capability to export XML files, but they use the parser in IE and so cannot be viewed by Firefox.. so I wrote some code to create (basic) xml and xsl files to display data in a table...
It is probably in need of some refinement, as I do not yet know a great deal about styling xml data and am still relatively inexperienced in VB... but it does seem to work. Only limitation will be maximum string length (~2 billion characters, according to MS vba help). code could be modified to use multiple strings and append them sequentially to the saved files if it is necessary to create files larger than this limit...
code is form based, I will start with the sub that starts the whole process and saves the files, then the functions which are called from this sub to create the XML and XSL strings which are then passed back and saved as files. Then I will try and post an example...
Code to create XML...
cont'd.....
It is probably in need of some refinement, as I do not yet know a great deal about styling xml data and am still relatively inexperienced in VB... but it does seem to work. Only limitation will be maximum string length (~2 billion characters, according to MS vba help). code could be modified to use multiple strings and append them sequentially to the saved files if it is necessary to create files larger than this limit...
code is form based, I will start with the sub that starts the whole process and saves the files, then the functions which are called from this sub to create the XML and XSL strings which are then passed back and saved as files. Then I will try and post an example...
Code:
Private Sub cmdXML_Click()
On Error GoTo Err_cmdXML_Click
'18/08/2006 R.Stevens
'Set reference for 'Microsoft Scripting Runtime' in Tools > References
'runs from a form with 3 text boxes named txtFileName for user to choose their own filename for .xml and .xsl documents, txtRoot for user to choose
'the root tagname for XML file and txtChild for user to choose a name for the child elements of the root.
'Also a command button named cmdXML.
'As it stands, both XML file and XSL stylesheet will be placed in the same folder and have the same name, although this could be altered if so desired
Dim strFilename As String
Dim strRoot As String
Dim strChild As String
Dim strSQL As String
Dim strXML As String
Dim strXSL As String
Dim fso As New Scripting.FileSystemObject
Dim ts As Scripting.TextStream
'first grab variables from text boxes on the form and check they are not empty
strFilename = Nz(Forms![YourFormName]!txtFilename, "NoFileName")
strRoot = Nz(Forms![YourFormName]!txtRoot, "NoRootChosen")
strChild = Nz(Forms![YourFormName]!txtChild, "NoChildChosen")
If strFilename = "NoFileName" Then
MsgBox "Please choose A filename!"
Me.txtFilename.SetFocus
GoTo Exit_cmdXML_Click
ElseIf strRoot = "NoRootChosen" Then
MsgBox "Please choose a name for the root tag!"
Me.txtRoot.SetFocus
GoTo Exit_cmdXML_Click
ElseIf strChild = "NoChildChosen" Then
MsgBox "Please choose a name for the child tags!"
End If
'next obtain SQL statement - in this case the SQL comes from another function bound to the form, but it could be called from a stored query
'or a textbox on the form etc etc...
strSQL = GetSQL()
If strSQL = "" Then
MsgBox "SQL statement is empty, please check the source"
GoTo Exit_cmdXML_Click
End If
'Pass SQL statement to functions which build XML and XSL strings, and store the returned strings
strXML = XML(strSQL, strFilename, strRoot, strChild)
strXSL = XSL(strSQL, strRoot, strChild)
'open the file with the name stored in strFilename. In this case I have chosen to store the folder to save to in hardcode, but it
'could easily be altered so that the full pathname must be entered into txtFilename. the 'True' argument means that the named file will be
'created if it does not exist. 'ForWriting' means that the entire file will be overwritten if it does exist
'note that the folder MUST already exist
Set ts = fso.OpenTextFile("C:\test\" & strFilename & ".xml", ForWriting, True)
'with the file open, write the xml text stream to it (note that this will work for any text file, even if it does not have the *.txt extension)
ts.Write strXML
'repeat the above for XSL file
Set ts = fso.OpenTextFile("C:\test\" & strFilename & ".xsl", ForWriting, True)
ts.Write strXSL
'close the text stream object
ts.Close
Set ts = Nothing
Exit_cmdXML_Click:
Exit Sub
Err_cmdXML_Click:
MsgBox "cmdXML_Click Error# " & Err.Number & " - " & Err.Description
End Sub
Code to create XML...
Code:
Public Function XML(strSQL As String, strFilename As String, strRoot As String, strChild As String) As String
On Error GoTo Err_XML
'18/08/2006 R.Stevens
'This function will take an SQL string and convert it to XML data format, with a reference to XSL stylesheet written by XSL Function
'Function uses ADO so set reference to 'Microsoft ActiveX Data Object Library' in Tools > References
Dim strXML As String
Dim varItem As Variant
Dim RS As ADODB.Recordset
Dim Connection As ADODB.Connection
Set RS = New ADODB.Recordset
Set Connection = Application.CurrentProject.Connection
'open recordset from SQL statement with the above connection
RS.Open strSQL, Connection, adOpenStatic
'check recordset is not empty
If RS.BOF And RS.EOF Then
MsgBox "There is a problem with your selection - the data you requested is not available"
GoTo Exit_XML
End If
'start building XML code - XML declaration, ref to style sheet location - this coding assumes it will be in the same folder
'and the root element are defined here
strXML = "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbCrLf & _
"<?xml-stylesheet type='text/xsl' href='" & strFilename & ".xsl'?>" & vbCrLf & _
"<" & strRoot & ">" & vbCrLf
'next we go through each record in the recordset, a child node is created for each record, and within that a child element is created for every field. these elements are named according to the field name.
'note 'Nz(varItem.Value, "-") in the code - null values here can cause problems on occasion...
RS.MoveFirst
While RS.EOF = False
strXML = strXML & _
" <" & strChild & ">" & vbCrLf
For Each varItem In RS.Fields
strXML = strXML & " <" & varItem.Name & ">" & Nz(varItem.Value, "-") & "</" & varItem.Name & ">" & vbCrLf
Next varItem
strXML = strXML & " </" & strChild & ">" & vbCrLf
RS.MoveNext
Wend
'next we add the root closing tag
strXML = strXML & "</" & strRoot & ">"
'As Firefox doesn't seem to like the '&' character within element values, and some of my data contains '&', I've added a string replace. comment this out if it is not necessary
strXML = Replace(strXML, "&", "and")
XML = strXML
'close connection and clear object variables
Connection.Close
Set Connection = Nothing
Set RS = Nothing
Exit_XML:
Exit Function
Err_XML:
MsgBox "Function XML Error # " & Err.Number & " - " & Err.Description
Resume Exit_XML
End Function
cont'd.....