Th next paragraph shows the details of the AccXml.xsl file generated with the above XML file. This is the file that transforms the XML data for presentation.
<?xml version="1.0"?> <xsl:stylesheet version="1.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:msxsl="urn:schemas-microsoft-com:xslt"
xmlns:fx="#fx-functions" exclude-result-prefixes="msxsl fx"> <xsl:output method="html" version="4.0" indent="yes"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"/> <xsl:template match="//dataroot"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> <html> <head> <META HTTP-EQUIV="Content-Type"
CONTENT="text/html;charset=UTF-8"/> <title>Argentina</title> <style type="text/css"></style> </head> <body link="#0000ff" vlink="#800080"> <table border="1" bgcolor="#ffffff"
cellspacing="0" cellpadding="0" id="CTRL1"> <colgroup> <col style="WIDTH: 0.9375in"/> <col style="TEXT-ALIGN: right; WIDTH: 0.9375in"/> <col style="TEXT-ALIGN: right; WIDTH: 0.9375in"/> <col style="WIDTH: 0.9375in"/> </colgroup> <tbody> <tr> <td> <div align="center"> <strong>CustomerID</strong> </div> </td> <td> <div align="center"> <strong>OrderDate</strong> </div> </td> <td> <div align="center"> <strong>RequiredDate</strong> </div> </td> <td> <div align="center"> <strong>ShipName</strong> </div> </td> </tr> </tbody> <tbody id="CTRL2"> <xsl:for-each select="Argentina"> <!-- Cache the current node in case the a field is
formatted --> <xsl:value-of select="fx:CacheCurrentNode(.)"/> <tr> <td> <xsl:value-of select="CustomerID"/> </td> <td> <xsl:value-of
select="fx:FormatFromXSL('OrderDate', '', '', '', 7)"/> </td> <td> <xsl:value-of
select="fx:FormatFromXSL('RequiredDate', '', '', '', 7)"/> </td> <td> <xsl:value-of select="ShipName"/> </td> </tr> </xsl:for-each> </tbody> </table> </body> </html> </xsl:template> <msxsl:script language="VBScript" implements-prefix="fx"
xmlns:msxsl="urn:schemas-microsoft-com:xslt"><![CDATA[ Option Explicit ' ******************************************************************* ' ** Functions dynamically generated to evaluate expressions used as
a Control Source ' ******************************************************************* ' ************************************************************* ' ** Functions dynamically generated to evaluate running sums ' ************************************************************* ' This function will calculate the running sums and expressions for the
Detail section Function CalculateExpressions_Detail(CurrentNode, GroupNodes) PrepExpressions CurrentNode, GroupNodes On Error Resume Next CalculateExpressions_Detail = "" End Function ' This function will calculate the running sums and expressions for the
Global section Function CalculateExpressions_Global(CurrentNode, GroupNodes) PrepExpressions CurrentNode, GroupNodes On Error Resume Next CalculateExpressions_Global = "" End Function ' ********************************************************************* ' **Functions dynamically generated to be used for sorting and grouping ' ********************************************************************* ' ************************************************ ' ** Code staticly copied for expressions to use ' *********************************************** 'variable declaration Dim objCurrNode Dim objCurrNodeT Dim cGroupCount Dim objGroupNodes Set objGroupNodes = Nothing Set objCurrNode = Nothing cGroupCount = 0 Function PrepExpressions(CurrentNode, GroupNodes) CacheCurrentNode CurrentNode CacheGroupNodes GroupNodes PrepExpressions = "" End Function Function CacheCurrentNode(objNodeList) Set objCurrNode = objNodeList.item(0) CacheCurrentNode = "" End Function Function CacheGroupNodes(objNodeList) Set objGroupNodes = objNodeList cGroupCount = objGroupNodes.length CacheGroupNodes = "" End Function Function GroupValue_quarter(strValue) GroupValue_quarter = Left(strValue, 4) &
DatePart("q", BuildDateFromStr(strValue, False)) End Function Function GroupValue_week(strValue) GroupValue_week = Left(strValue, 4) &
DatePart("ww", BuildDateFromStr(strValue, False)) End Function Function GroupValue_interval(nValue, nInterval) GroupValue_interval = Int(nValue / nInterval) End Function Function Page() Page = 1 End Function Function Pages() Pages = 1 End Function Function ToString(varValue) On Error Resume Next ToString = "" ToString = CStr(varValue) End Function Function ToNumber(varValue) On Error Resume Next ToNumber = 0 ToNumber = CDbl(varValue) End Function Function FormatFromXSL(strRef, strFormat, iNumDecimals, LCID, nType) FormatFromXSL = ToString(Format(GetValue(strRef, nType),
strFormat, iNumDecimals, LCID, nType)) End Function Function Format(varValue, strFormat, iNumDecimals, LCID, nType) Dim FormatTemp Dim strTemp If IsDate(varValue) Then Select Case strFormat Case "General Date" FormatTemp = FormatDateTime(varValue, vbGeneralDate) Case "Long Date" FormatTemp = FormatDateTime(varValue, vbLongDate) Case "Medium Date" FormatTemp = Day(varValue) & "-" & MonthName
(Month(varValue), True) & "-" & Mid(Year(varValue), 3, 2) Case "Short Date" FormatTemp = FormatDateTime(varValue, vbShortDate) Case "Long Time" FormatTemp = FormatDateTime(varValue, vbLongTime) Case "Medium Time" strTemp = FormatDateTime(varValue, vbLongTime) If (IsNumeric(Mid(strTemp, 2, 1))) Then FormatTemp = Mid(strTemp,1,5) & Mid(strTemp, 9) Else FormatTemp = Mid(strTemp,1,4) & Mid(strTemp, 9) End If Case "Short Time" FormatTemp = FormatDateTime(varValue, vbShortTime) Case Else Select Case LCase(strFormat) Case "yyyy", "q", "m", "y", "d", "w", "ww", "h", "n", "s" FormatTemp = DatePart(LCase(strFormat), varValue) Case Else ' This does not currently support custom formats such
as dd-mmm-yyyy FormatTemp = FormatDateTime(varValue, vbGeneralDate) End Select End Select ElseIf IsNumeric(varValue) Then Select Case strFormat Case "General Number" FormatTemp = varValue Case "Currency" FormatTemp = FormatCurrencyPerLocale(varValue,
iNumDecimals, LCID) Case "Euro" ' This does not really support the Euro format. FormatTemp = FormatCurrencyPerLocale(varValue,
iNumDecimals, LCID) Case "Fixed" If IsNumeric(iNumDecimals) Then FormatTemp =
FormatNumber(varValue, iNumDecimals, vbTrue, vbUseDefault, vbFalse) Else FormatTemp =
FormatNumber(varValue, 2, vbTrue, vbUseDefault, vbFalse) End If Case "Standard" If IsNumeric(iNumDecimals) Then FormatTemp =
FormatNumber(varValue, iNumDecimals, vbUseDefault, vbUseDefault, vbTrue) Else FormatTemp =
FormatNumber(varValue, 2, vbUseDefault, vbUseDefault, vbTrue) End If Case "Percent" If IsNumeric(iNumDecimals) Then FormatTemp = FormatPercent(varValue, iNumDecimals) Else FormatTemp = FormatPercent(varValue) End If Case "Scientific" Dim nExp Dim nValue If (varValue = 0) Then nExp = 0 Else nExp = Int(Log(Abs(varValue)) / Log(10)) End If nValue = Round(CDbl(varValue)/(10^CDbl(nExp)), 2) If (Sgn(nExp) < 0) Then FormatTemp =
FormatNumber(nValue, 2, vbTrue, vbFalse, vbFalse) & "E" & nExp Else FormatTemp =
FormatNumber(nValue, 2, vbTrue, vbFalse, vbFalse) & "E+" & nExp End If Case "True/False" If (CBool(varValue)) Then FormatTemp = "True" Else FormatTemp = "False" End If Case "Yes/No" If (CBool(varValue)) Then FormatTemp = "Yes" Else FormatTemp = "No" End If Case "On/Off" If (CBool(varValue)) Then FormatTemp = "On" Else FormatTemp = "Off" End If Case Else ' This is a custom format If nType = 6 Then ' This is a currency FormatTemp = FormatCurrencyPerLocale(varValue,
iNumDecimals, LCID) End If End Select End If If IsEmpty(FormatTemp) Then FormatTemp = varValue End If If FHasNoContent(FormatTemp) Then Format = " " Else Format = FormatTemp End If End Function Function FormatCurrencyPerLocale(varValue,
iNumDecimals, LCID) Dim CurrentLCID If LCID >< "" Then CurrentLCID = SetLocale(LCID) If IsNumeric(iNumDecimals) Then FormatCurrencyPerLocale = FormatCurrency(varValue,
iNumDecimals) Else FormatCurrencyPerLocale = FormatCurrency(varValue) End If If Not IsEmpty(CurrentLCID) Then SetLocale CurrentLCID End Function Function FHasNoContent(objValue) FHasNoContent = True If IsNull(objValue) Then Exit Function If IsEmpty(objValue) Then Exit Function If Not IsObject(objValue) Then If objValue = "" Then Exit Function Else If objValue Is Nothing Then Exit Function End if FHasNoContent = False End Function Function IIf(fCond, varTrue, varFalse) If fCond Then IIf = varTrue Else IIf = varFalse End If End Function Function Nz(varValue, varReplace) If FHasNoContent(varValue) Then Nz = varReplace Else Nz = varValue End If End Function Function Sum(strExpr) Dim nSum, i nSum = 0 Set objCurrNodeT = objCurrNode For i = 0 To cGroupCount - 1 Set objCurrNode = objGroupNodes.item(i) nSum = nSum + ToNumber(Eval(strExpr)) Next Set objCurrNode = objCurrNodeT Sum = nSum End Function Function Count(strExpr) Dim nCount, i If strExpr = "*" Then Count = cGroupCount Exit Function End If Set objCurrNodeT = objCurrNode nCount = 0 For i = 0 To cGroupCount - 1 Set objCurrNode = objGroupNodes.item(i) If Not FHasNoContent(Eval(strExpr)) Then nCount = nCount + 1 End If Next Set objCurrNode = objCurrNodeT Count = nCount End Function Function Avg(strExpr) Dim nSum Dim nCount nSum = Sum(strExpr) nCount = Count(strExpr) If nCount > 0 Then Avg = nSum / nCount Else Avg = nSum End If End Function Function Min(strExpr) Dim varMin, i Dim varTemp Set objCurrNodeT = objCurrNode For i = 0 To cGroupCount - 1 Set objCurrNode = objGroupNodes.item(i) varTemp = Eval(strExpr) If IsEmpty(varMin) Or (varTemp < varMin) Then varMin = varTemp End If Next Set objCurrNode = objCurrNodeT Min = varMin End Function Function Max(strExpr) Dim varMax, i Dim varTemp varMax = Eval(strExpr) Set objCurrNodeT = objCurrNode For i = 0 To cGroupCount - 1 Set objCurrNode = objGroupNodes.item(i) varTemp = Eval(strExpr) If IsEmpty(varMax) Or (varTemp > varMax) Then varMax = varTemp End If Next Set objCurrNode = objCurrNodeT Max = varMax End Function Function GetValue(strRef, nType) ' Set Null as the default return value GetValue = Null ' Return Null if anything goes wrong On Error Resume Next Dim objNode Set objNode = objCurrNode.selectSingleNode(strRef) If (objNode Is Nothing) Or IsNull(objNode) Or IsEmpty(objNode)
Or Not IsObject(objNode) Then Exit Function End If Dim CurrentLCID CurrentLCID = SetLocale(1033) Select Case nType Case 2 ' adSmallInt GetValue = CLng(objNode.text)
Case 3 ' adInteger GetValue = CLng(objNode.text)
Case 20 ' adBigInt GetValue = CLng(objNode.text) Case 17 ' adUnsignedTinyInt GetValue = CLng(objNode.text) Case 18 ' adUnsignedSmallInt GetValue = CLng(objNode.text) Case 19 ' adUnsignedInt GetValue = CLng(objNode.text) Case 21 ' adUnsignedBigInt GetValue = CLng(objNode.text) Case 4 ' adSingle GetValue = CDbl(objNode.text) Case 5 ' adDouble GetValue = CDbl(objNode.text) Case 6 ' adCurrency GetValue = CCur(objNode.text) Case 14 ' adDecimal GetValue = CDbl(objNode.text) Case 131 ' adNumeric GetValue = CDbl(objNode.text) Case 139 ' adVarNumeric GetValue = CDbl(objNode.text) Case 11 ' adBoolean GetValue = CBool(objNode.text) Case 7 ' adDate GetValue = BuildDateFromStr(objNode.text, True) Case 133 ' adDBDate GetValue = BuildDateFromStr(objNode.text, True) Case 134 ' adDBTime GetValue = BuildDateFromStr(objNode.text, True) Case 135 ' adDBTimeStamp GetValue = BuildDateFromStr(objNode.text, True) Case 8 ' adBSTR GetValue = objNode.text Case 120 ' adChar GetValue = objNode.text Case 200 ' adVarChar GetValue = objNode.text Case 201 ' adLongVarChar GetValue = objNode.text Case 130 ' adWChar: GetValue = objNode.text Case 202 ' adVarWChar GetValue = objNode.text Case 203 ' adLongVarWChar GetValue = objNode.text Case -7 ' Special value used to get
just the date. GetValue = BuildDateFromStr(objNode.text, False) Case Else GetValue = objNode.text End Select SetLocale CurrentLCID End Function Dim gStaticDate Function StaticDate() If IsEmpty(gStaticDate) Then gStaticDate =
GetValue("/*/@generated", -7) StaticDate = gStaticDate End Function Dim gStaticNow Function StaticNow() If IsEmpty(gStaticNow) Then gStaticNow =
GetValue("/*/@generated", 7) StaticNow = gStaticNow End Function Function BuildDateFromStr(strDate, fIncludeTime) Dim CurrentLCID CurrentLCID = SetLocale(1033) ' This requires that the Locale be set to en-us (1033). BuildDateFromStr = CDate(Left(strDate,10)) If (fIncludeTime) Then BuildDateFromStr = BuildDateFromStr +
CDate(Right(strDate,8)) End If SetLocale CurrentLCID End Function Function ArrayItem(arr, index) If index > UBound(arr) Then ArrayItem = "" Else ArrayItem = arr(index) End If End Function Function HyperlinkPartFromNodeList(nodelist, nPart) If nodelist.length = 0 Then HyperlinkPartFromNodeList = "" Else HyperlinkPartFromNodeList =
HyperlinkPartFromString(nodelist.item(0).text, nPart) End If End Function Function HyperlinkPart(strRef, nPart) HyperlinkPart =
HyperlinkPartFromString(GetValue(strRef, 200), nPart) End Function Function HyperlinkPartFromString(strHyperlink, nPart) Dim arrParts Dim strHyperlinkPart Dim strAddress, strSubAddress arrParts = Split(strHyperlink, "#") Select Case nPart Case 0 ' acDisplayedValue strHyperlinkPart = ArrayItem(arrParts, 0) If strHyperlinkPart = "" Then strAddress = ArrayItem(arrParts, 1) strSubAddress = ArrayItem(arrParts, 2) If strAddress = "" and strSubAddress = "" Then strHyperlinkPart = "" ElseIf strSubAddress = "" Then strHyperlinkPart = strAddress ElseIf strAddress = "" Then strHyperlinkPart = strSubAddress Else strHyperlinkPart = strAddress & " - " & strSubAddress End If End If Case 1 ' acDisplayText strHyperlinkPart = ArrayItem(arrParts, 0) Case 2 ' acAddress strHyperlinkPart = ArrayItem(arrParts, 1) Case 3 ' acSubAddress strHyperlinkPart = ArrayItem(arrParts, 2) Case 4 ' acScreenTip strHyperlinkPart = ArrayItem(arrParts, 3) Case 5 ' acFullAddress strAddress = ArrayItem(arrParts, 1) strSubAddress = ArrayItem(arrParts, 2) If strAddress = "" and strSubAddress = "" Then strHyperlinkPart = "#" ElseIf strSubAddress = "" Then strHyperlinkPart = strAddress Else strHyperlinkPart = strAddress & "#" & strSubAddress End If End Select HyperlinkPartFromString = strHyperlinkPart End Function ]]></msxsl:script> </xsl:stylesheet>
Some of the things to note are that the language used is VB Script, the elements are processed by the code which forms part of the style sheet file, and the functions in the code are referenced in the second line after the XML processing line. The code is of course enclosed in the CDATA section. It is generic code, only parts of which are used in this simple example. In general, if one were to write XSL for a given XML file, one could hand code the sheet and the amount of code will be much smaller. For those who are interested in generating XSL code, the functions used in this file shown can be very useful; although it can be generated from MS Access, it is included for the sake of completeness.
Summary
The tutorial looked at the Export utility in MS Access 2003 to see how well the data was exported. In the simple example used, exporting to XML was highly satisfactory and provided the various related 'xml' files with good documentation. The Vb script functions in the CDATA section should be valuable to those who are interested in XSL. The import was tested with Microsoft Office Access 2003 (11.6566.6568) SP2 on Office XP Professional Media Center Edition.
| DISCLAIMER: The content provided in this article is not warranted or guaranteed by Developer Shed, Inc. The content provided is intended for entertainment and/or educational purposes in order to introduce to the reader key ideas, concepts, and/or product reviews. As such it is incumbent upon the reader to employ real-world tactics for security and implementation of best practices. We are not liable for any negative consequences that may result from implementing any information covered in our articles or tutorials. If this is a hardware review, it is not recommended to open and/or modify your hardware. |
|