I wrote an XML reader and writer that uses the parser. It uses a simple
file that I save my UDT to and load my UDT from each time. I found
documentation on how to use an XML file in VB very sparse. Thanks MS.
I have attached my file.
David Urban
Mark Propst wrote:
> oooh oooh oooh! :-)
> Yes please, that'd be really nice!
> I got the two references installed/ the vbaccelerator treeview control and
> the 2.8mdac
> and that's a great little example of using different storage mediums for the
> same info.
>
> a further example on xml would be much appreciated....
> always easier to learn from a few actual examples than reems of msdn pages!
> Thanks in advance
> Mark
>
> "Mike Tuersley" wrote in message
> news:1jc7sj0rgon5s$.2i20vfwqhnzt$.dlg@40tude.net...
>
>>If you want a more detailed example on xml, let me know. The one posted is
>>very basic and uses a SQL query against it instead of a normal parser.
>
>
>
Attribute VB_Name = "XML"
Option Explicit
Public Sub Save_toXML()
Dim oDoc As DOMDocument
Dim oAlg As IXMLDOMElement
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Dim oRoot As IXMLDOMElement
Dim oStation As IXMLDOMAttribute
Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
On Error Resume Next
oDoc.Load (fXMLFile)
Set oRoot = oDoc.documentElement
'If Err.Number <> 0 Then
oDoc.resolveExternals = True
If oDoc.parseError <> 0 Then
' Create processing instruction and document root
Set oAlg = oDoc.createProcessingInstruction("xml", "version='1.0'")
Set oAlg = oDoc.insertBefore(oAlg, oDoc.childNodes.Item(0))
' Create document root
Set oRoot = oDoc.createElement("Project_" & CStr(Project))
Set oDoc.documentElement = oRoot
' oRoot.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"
'Else
'Set oRoot = oDoc.documentElement
End If
Err.Clear
Dim events As Variant, alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
name2 = oAlg.baseName
If name2 <> "" Then
oRoot.removeChild oAlg
End If
Set oAlg = oDoc.createElement(name)
oRoot.appendChild oAlg
For x = LBound(AlignPt, 1) To UBound(AlignPt, 1)
Set oSta = oDoc.createElement("Sta" & Format(AlignPt(x).Station, "0.00"))
oAlg.appendChild oSta
Write_XMLStation oSta, oDoc, AlignPt(x)
Next x
' Save xml file
oDoc.Save fXMLFile
End Sub
Public Function Load_fromXML() As Boolean
Dim oDoc As DOMDocument
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
On Error Resume Next
oDoc.Load (fXMLFile)
'Set oRoot = oDoc.documentElement
'If Err.Number <> 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
Debug.Print Err.Number
name2 = oAlg.baseName
If name2 <> "" Then
Debug.Print Err.Number
ReDim AlignPt(oAlg.childNodes.length - 1)
For x = 0 To oAlg.childNodes.length - 1
Set oSta = oAlg.childNodes.Item(x)
Read_XMLStation oSta, AlignPt(x)
Next x
Load_fromXML = True
End If
End If
Set oDoc = Nothing
End Function
Public Function Delete_Sta_fromXML(Station) As Boolean
Dim oDoc As DOMDocument
Delete_Sta_fromXML = False
Dim oAlg As IXMLDOMElement
Dim oSta As IXMLDOMNode
Dim oRoot As IXMLDOMElement, oTree As IXMLDOMNamedNodeMap
Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
On Error Resume Next
oDoc.Load (fXMLFile)
Set oRoot = oDoc.documentElement
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
alignName = "//Project_" & CStr(Project) & "//" & name & "//" & "Sta" & Format(Station, "0.00")
Set oSta = oDoc.selectSingleNode(alignName)
oAlg.removeChild oSta
oDoc.Save fXMLFile
Delete_Sta_fromXML = True
End If
End If
End Function
Public Function Update_station(temp As junctions) As Boolean
Dim oDoc As DOMDocument
Update_station = False
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Update_station = False
Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
Err.Clear: On Error Resume Next
oDoc.Load (fXMLFile)
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
alignName = "//Project_" & CStr(Project) & "//" & name & "//" & "Sta" & Format(temp.Station, "0.00")
Set oSta = oDoc.selectSingleNode(alignName)
Debug.Print Err.Number
name2 = oSta.baseName
If name2 <> "" Then
oAlg.removeChild oSta
End If
Set oSta = oDoc.createElement("Sta" & Format(temp.Station, "0.00"))
oAlg.appendChild oSta
Write_XMLStation oSta, oDoc, temp
oDoc.Save fXMLFile
Update_station = True
End If
End If
End Function
Private Sub Write_XMLStation(oSta As IXMLDOMElement, oDoc As DOMDocument, temp As junctions)
Dim oLat1 As IXMLDOMElement, oLat2 As IXMLDOMElement
oSta.setAttribute "Station", temp.Station
oSta.setAttribute "Event", temp.Event
oSta.setAttribute "Direction", temp.Direction
oSta.setAttribute "DirectionUP", temp.DirectionUP
oSta.setAttribute "Easting", temp.Easting
oSta.setAttribute "Northing", temp.Northing
oSta.setAttribute "Pipesize", temp.Pipesize
oSta.setAttribute "PipesizeUP", temp.PipesizeUP
oSta.setAttribute "Flowline", temp.FlowLine
Set oLat1 = oDoc.createElement("Lateral1")
oSta.appendChild oLat1
oLat1.setAttribute "name", temp.Lateral1.name
oLat1.setAttribute "Station", temp.Lateral1.INTStation
oLat1.setAttribute "count", temp.Lateral1.count
oLat1.setAttribute "Direction", temp.Lateral1.Direction
oLat1.setAttribute "eEast", temp.Lateral1.EndEasting
oLat1.setAttribute "eNorth", temp.Lateral1.EndNorthing
oLat1.setAttribute "eSta", temp.Lateral1.EndStation
Set oLat2 = oDoc.createElement("Lateral2")
oSta.appendChild oLat2
oLat2.setAttribute "name", temp.Lateral2.name
oLat2.setAttribute "Station", temp.Lateral2.INTStation
oLat2.setAttribute "count", temp.Lateral2.count
oLat2.setAttribute "Direction", temp.Lateral2.Direction
oLat2.setAttribute "eEast", temp.Lateral2.EndEasting
oLat2.setAttribute "eNorth", temp.Lateral2.EndNorthing
oLat2.setAttribute "eSta", temp.Lateral2.EndStation
End Sub
Private Sub Read_XMLStation(oSta As IXMLDOMElement, temp As junctions)
Dim oLat1 As IXMLDOMElement, oLat2 As IXMLDOMElement
With temp
.Station = oSta.getAttribute("Station")
.Event = oSta.getAttribute("Event")
.Direction = oSta.getAttribute("Direction")
.DirectionUP = oSta.getAttribute("DirectionUP")
.Easting = oSta.getAttribute("Easting")
.Northing = oSta.getAttribute("Northing")
.Pipesize = oSta.getAttribute("Pipesize")
.PipesizeUP = oSta.getAttribute("PipesizeUP")
.FlowLine = oSta.getAttribute("Flowline")
Set oLat1 = oSta.firstChild
.Lateral1.name = oLat1.getAttribute("name")
.Lateral1.INTStation = oLat1.getAttribute("Station")
.Lateral1.count = oLat1.getAttribute("count")
.Lateral1.Direction = oLat1.getAttribute("Direction")
.Lateral1.EndEasting = oLat1.getAttribute("eEast")
.Lateral1.EndNorthing = oLat1.getAttribute("eNorth")
.Lateral1.EndStation = oLat1.getAttribute("eSta")
Set oLat2 = oSta.lastChild
.Lateral2.name = oLat2.getAttribute("name")
.Lateral2.INTStation = oLat2.getAttribute("Station")
.Lateral2.count = oLat2.getAttribute("count")
.Lateral2.Direction = oLat2.getAttribute("Direction")
.Lateral2.EndEasting = oLat2.getAttribute("eEast")
.Lateral2.EndNorthing = oLat2.getAttribute("eNorth")
.Lateral2.EndStation = oLat2.getAttribute("eSta")
End With
End Sub
Public Function read_rec_fromXML(alignmentName As String, Station As Double, Xtemp As junctions) As Boolean
Dim oDoc As DOMDocument
read_rec_fromXML = False
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
Err.Clear: On Error Resume Next
oDoc.Load (fXMLFile)
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(alignmentName, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
alignName = "//Project_" & CStr(Project) & "//" & name & "//" & "Sta" & Format(Station, "0.00")
Set oSta = oDoc.selectSingleNode(alignName)
Debug.Print Err.Number
name2 = oSta.baseName
If name2 <> "" Then
Read_XMLStation oSta, Xtemp
read_rec_fromXML = True
End If
End If
End If
End Function
Public Function delete_begin_end(events As String) As Boolean
Dim oDoc As DOMDocument
Dim oAlg As IXMLDOMNode, nodes As IXMLDOMNode
Dim oSta As IXMLDOMElement
Dim oLat1 As IXMLDOMElement
Dim oLat2 As IXMLDOMElement
Update_station = False
Set oDoc = Nothing
Set oDoc = New DOMDocument
oDoc.async = False
Err.Clear: On Error Resume Next
oDoc.Load (fXMLFile)
If Err.Number = 0 Then
oDoc.resolveExternals = True
If oDoc.parseError = 0 Then
Dim alignName As String
Dim x As Integer, name As String, name2 As String
name = Replace(algname, " ", "_")
alignName = "//Project_" & CStr(Project) & "//" & name
Set oAlg = oDoc.selectSingleNode(alignName)
Set oSta = oAlg.firstChild
While oAlg.nextSibling <> oAlg.lastChild
Select Case events
Case "Begin"
If oSta.getAttribute("Event") = "Begin Construction" Then
oAlg.removeChild oSta
End If
Case "End"
If oSta.getAttribute("Event") = "End Construction" Then
oAlg.removeChild oSta
End If
End Select
Set oSta = oAlg.nextSibling
Wend
End If
End If
End Function