Search code examples
xmlms-accessvbams-access-2013

MS Access VBA parse XML File


I'm having a tough time here. I'm trying to import and parse an XML file with VBA. However, the .LoadXML function doesn't seem to be working. I've loaded the Microsoft XML, v6.0 reference and the XML file is valid. Here's a portion of the code:

Public Function ParseXML(ByVal strXMLFilename As String) As Boolean

Dim intFile As Integer
Dim strXMLFile As String
Dim xmlDoc As Object
Dim xmlTransmission As Object 'MSXML2.IXMLDOMNode
Dim xmlSurvey As Object 'MSXML2.IXMLDOMNode
Dim xmlRecord As Object 'MSXML2.IXMLDOMNode
Dim xmlField As Object 'MSXML2.IXMLDOMNode
Dim xmlAttrib As MSXML2.IXMLDOMAttribute
Dim ctrFields As Long
Dim strTargetTable As String
Dim xmlrs As DAO.Recordset

Set xmlDoc = New MSXML2.DOMDocument

intFile = FreeFile()
Open strXMLFilename For Input As intFile
strXMLFile = input$(LOF(1), 1)
Close intFile

Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
xmlDoc.LoadXML strXMLFile


ctrFields = 0

For Each xmlTransmission In xmlDoc.ChildNodes 'xmlNodes
    '...do a bunch of stuff...
Next xmlTransmission

End Function

Once it gets to the "For Each" statement, it jumps out of the loop and exits the function. I've also tried to load the strXMLFile variable with:

Open strXMLFilename For Input As intFile
Line Input #intFile, strXMLFile
Close intFile

But that only by the time I get to the .LoadXML function, strXMLFile is only equal to the last line of the file. What am I doing wrong?


Solution

  • The .loadXML Method loads the XML from a string, but if you already have the file spec you can just use the .load Method to load the XML directly from the file. For example, given the following file "sample.gpx" (an XML file used by navigation devices to store locations) ...

    <?xml version="1.0" encoding="UTF-8" standalone="no" ?>
    <gpx xmlns="http://www.topografix.com/GPX/1/1" xmlns:gpxx="http://www.garmin.com/xmlschemas/GpxExtensions/v3" creator="Extra_POI_Editor V5.33" version="1.1" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd http://www.garmin.com/xmlschemas/GpxExtensions/v3 http://www8.garmin.com/xmlschemas/GpxExtensions/v3/GpxExtensionsv3.xsd">
      <metadata><!--
                                                                                                                                                                                                                                                           Extra_POI_Editor can only be used for personnal usage and not for any commercial purposes without a written permission of the author, aka TurboCCC. I can be reached at [email protected].
      --><link href="http://turboccc.wikispaces.com"></link>
        <time>2013-10-26T00:36:17Z</time>
      </metadata>
    
      <wpt lat="51.056128" lon="-113.982223">
        <name>Harveys: Calgary</name>
        <cmt> </cmt>
        <extensions>
          <gpxx:WaypointExtension>
            <gpxx:Address>
              <gpxx:StreetAddress>Northgate Village Mall, 525-36th St. N.E.</gpxx:StreetAddress>
              <gpxx:City>Calgary</gpxx:City>
              <gpxx:State>AB</gpxx:State>
              <gpxx:PostalCode>T2A 6K3</gpxx:PostalCode>
            </gpxx:Address>
            <gpxx:PhoneNumber>403-272-9641</gpxx:PhoneNumber>
          </gpxx:WaypointExtension>
        </extensions>
      </wpt>
    
      <wpt lat="51.134358" lon="-114.010802">
        <name>Harveys: Calgary (Airport)</name>
        <cmt> </cmt>
        <extensions>
          <gpxx:WaypointExtension>
            <gpxx:Address>
              <gpxx:StreetAddress>2000 Airport Rd. N.E.</gpxx:StreetAddress>
              <gpxx:City>Calgary</gpxx:City>
              <gpxx:State>AB</gpxx:State>
              <gpxx:PostalCode>T2E 6W5</gpxx:PostalCode>
            </gpxx:Address>
            <gpxx:PhoneNumber>403-250-9177</gpxx:PhoneNumber>
          </gpxx:WaypointExtension>
        </extensions>
      </wpt>
    
    </gpx>
    

    ... the following code will extract the longitude, latitude, and name of each location ...

    Option Compare Database
    Option Explicit
    
    Sub xmlTest()
        Dim lon As Double, lat As Double, poiName As String
        ' VBA project reference required:
        ' Microsoft XML, v6.0
        Dim xmlDoc As New MSXML2.DOMDocument60
        If xmlDoc.Load("C:\__tmp\sample.gpx") Then
            Dim xmlTopLevelNode As MSXML2.IXMLDOMNode
            For Each xmlTopLevelNode In xmlDoc.childNodes
                If xmlTopLevelNode.nodeName = "gpx" Then
                    Dim gpxNode As MSXML2.IXMLDOMNode
                    For Each gpxNode In xmlTopLevelNode.childNodes
                        If gpxNode.nodeName = "wpt" Then
                            Dim wptAttribute As MSXML2.IXMLDOMNode
                            For Each wptAttribute In gpxNode.Attributes
                                Select Case wptAttribute.nodeName
                                    Case "lat":
                                        lat = CDbl(wptAttribute.nodeTypedValue)
                                    Case "lon":
                                        lon = CDbl(wptAttribute.nodeTypedValue)
                                End Select
                            Next
                            Set wptAttribute = Nothing
                            Dim wptChildNode As MSXML2.IXMLDOMNode
                            For Each wptChildNode In gpxNode.childNodes
                                If wptChildNode.nodeName = "name" Then
                                    poiName = wptChildNode.nodeTypedValue
                                End If
                                Exit For
                            Next
                            Set wptChildNode = Nothing
                            Debug.Print lon & "," & lat & "," & """" & Replace(poiName, """", """""") & """"
                        End If
                    Next
                    Set gpxNode = Nothing
                End If
            Next
            Set xmlTopLevelNode = Nothing
        Else
            Debug.Print "Unable to load XML file."
        End If
        Set xmlDoc = Nothing
    End Sub
    

    ... and print it to the VBA Immediate window:

    -113.982223,51.056128,"Harveys: Calgary"
    -114.010802,51.134358,"Harveys: Calgary (Airport)"