Parse XML VBA

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am looking for instructions on how to parse a XML response received from a
web service into variable components for storage in an access table. I have
tried the application.importxml method and it is not providing the results I
need. Is there a way to pull elements from a XML message and populate them
into a table or recordset?

In the example below, I am mainly interested in capturing the jurisdiction
level EffectiveRate and TotalTax.

Sample XML Response:

</Destination>
Click to expand...
</Buyer>
<Purchase purchaseClass="" >999GeoCodeContainer</Purchase>
<Quantity >200603.0</Quantity>
<ExtendedPrice >1000.0</ExtendedPrice>
<Taxes taxResult="TAXABLE" taxType="CONSUMERS_USE" maxTaxIndicator="false"
situs="D" taxRuleId="9967" ><Jurisdiction jurisdictionLevel="STATE"
jurisdictionId="19873" >MISSOURI</Jurisdiction>
<CalculatedTax >42.25</CalculatedTax>
<EffectiveRate >0.04225</EffectiveRate>
<Taxable >1000.0</Taxable>
</Taxes>
<Taxes taxResult="TAXABLE" taxType="CONSUMERS_USE" maxTaxIndicator="false"
situs="D" taxRuleId="34295" ><Jurisdiction jurisdictionLevel="COUNTY"
jurisdictionId="20883" >PLATTE</Jurisdiction>
<CalculatedTax >13.75</CalculatedTax>
<EffectiveRate >0.01375</EffectiveRate>
<Taxable >1000.0</Taxable>
</Taxes>
<Taxes taxResult="TAXABLE" taxType="CONSUMERS_USE" maxTaxIndicator="false"
situs="D" taxRuleId="36533" ><Jurisdiction jurisdictionLevel="CITY"
jurisdictionId="77468" >KANSAS CITY</Jurisdiction>
<CalculatedTax >23.75</CalculatedTax>
<EffectiveRate >0.02375</EffectiveRate>
<Taxable >1000.0</Taxable>
</Taxes>
<TotalTax >79.75</TotalTax>
</LineItem>
 
hi,
I am looking for instructions on how to parse a XML response received from a
web service into variable components for storage in an access table. I have
tried the application.importxml method and it is not providing the results I
need. Is there a way to pull elements from a XML message and populate them
into a table or recordset?
Click to expand...
You may use MSXML2. Just set a reference to Microsoft XML.

http://www.google.com/search?q=+MSXML2+vba

In the example below, I am mainly interested in capturing the jurisdiction
level EffectiveRate and TotalTax.
Click to expand...
I would import as a table and use SQL to get the data.


mfG
--> stefan <--
 
I was able to finally figure this out in the wee hours of the morning. For
others with similiar requirements, I have pasted my code below. I would
welcome comments as to the structure of the code:

Public Function ReadXMLDoc(ByVal strXMLResponse As String, _
ByVal strGeoCode As String, _
ByVal strPeriod As String) As Boolean
On Err GoTo errhandler

Dim xmldoc As New DOMDocument
Dim rs As ADODB.Recordset
Dim db As Database
Dim strSql As String
Dim conn As Connection
Dim n As Integer
'Dim objNodeJuris As Object
'Dim objNodeRates As Object

Set db = CurrentDb

Set rs = New ADODB.Recordset

strSql = "select * from tbl_rates where 1=2" 'open empty recordset from
tbl_rates

With rs
.ActiveConnection = CurrentProject.Connection
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open strSql
End With

'xmldoc.Load ("c:\temp\test.xml") ' Load from file
xmldoc.LoadXML (strXMLResponse) 'load from string passed

Set objnodelistjuris = xmldoc.selectNodes("//LineItem/Taxes/Jurisdiction")
Set objnodelistrates = xmldoc.selectNodes("//LineItem/Taxes/EffectiveRate")

rs.AddNew

For i = 0 To (objnodelistjuris.length - 1)
Set objNodeJuris = objnodelistjuris.nextNode
Set objNodeRates = objnodelistrates.nextNode
Debug.Print objNodeJuris.Text
Debug.Print objNodeRates.Text

n = n + 1
If n > 10 Then
Exit For 'if greater than 10 levels of tax, exit loop
End If

rs.Fields("GeoCode").Value = strGeoCode
rs.Fields("period").Value = strPeriod
rs.Fields("jurisname" & n).Value = objNodeJuris.Text
rs.Fields("jurisrate" & n).Value = objNodeRates.Text


'Set objnodelistrates =
xmldoc.selectNodes("//LineItem/Taxes/EffectiveRate")
'For n = 0 To (objnodelistrates.length - 1)
'Set objnoderates = objnodelistrates.nextNode
' Debug.Print objnoderates.Text
'Next n

Next i
rs.Update
'Debug.Print i, j



Set objnodelistjuris = Nothing
Set objnodelistrates = Nothing
Set objNodeJuris = Nothing
Set objNodeRates = Nothing
Set db = Nothing
Set rs = Nothing
ReadXMLDoc = True

Exit Function

errhandler:
Err.Raise Err.Number, "ReadXMLDoc", Err.Description
Set objnodelistjuris = Nothing
Set objnodelistrates = Nothing
Set objNodeJuris = Nothing
Set objNodeRates = Nothing
Set db = Nothing
Set rs = Nothing
ReadXMLDoc = False
End Function
 
Back
Top