MS Access VBA parse XML File

心已入冬 提交于 2020-01-25 01:34:53

问题


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?


回答1:


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 turboccc@hotmail.com.
  --><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)"


来源:https://stackoverflow.com/questions/29525064/ms-access-vba-parse-xml-file

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!