1 Dim p As New Person
2Dim c As Car
3
4' Load the XML
5p.FromXmlFile "SampleFile.xml"
6
7Debug.Print p.Name_ & " was born " & _
8 p.DateOfBirth.ToString & ", and lives at " & _
9 p.Address.HouseNo & ", " & _
10 p.Address.PostCode
11
12Debug.Print "Cars Owned (" & p.Cars.Count & ")"
13For Each c In p.Cars
14 Debug.Print " " & c.Make & ", " & c.Model
15Next
| 1Dim xmlDoc As New MSXML2.DOMDocument
2
3xmlDoc.Load ("SampleFile.xml")
4
5Dim xmlElmPerson As MSXML2.IXMLDOMElement
6Set xmlElmPerson = GetFirstElement(xmlDoc)
7If xmlElmPerson Is Nothing Then
8 Err.Raise -1, "Test", "Must start with Person"
9ElseIf xmlElmPerson.nodeName <> "Person" Then
10 Err.Raise -1, "Test", "Unexpected element"
11End If
12
13Dim xmlElmName As MSXML2.IXMLDOMElement
14Set xmlElmName = GetFirstElement(xmlElmPerson)
15If xmlElmName Is Nothing Then
16 Err.Raise -1, "Test", "Missing Person->Name"
17ElseIf xmlElmName.nodeName <> "Name" Then
18 Err.Raise -1, "Test", "Unexpected element"
19End If
20
21Dim xmlElmDOB As MSXML2.IXMLDOMElement
22Set xmlElmDOB = GetNextElement(xmlElmName)
23If xmlElmDOB Is Nothing Then
24 Err.Raise -1, "Test", "Missing Person->DateOfBirth"
25ElseIf xmlElmDOB.nodeName <> "DateOfBirth" Then
26 Err.Raise -1, "Test", "Unexpected element"
27End If
28
29Dim xmlElmAddress As MSXML2.IXMLDOMElement
30Set xmlElmAddress = GetNextElement(xmlElmDOB)
31If xmlElmAddress Is Nothing Then
32 Err.Raise -1, "Test", "Missing Person->Address"
33ElseIf xmlElmAddress.nodeName <> "Address" Then
34 Err.Raise -1, "Test", "Unexpected element"
35End If
36
37Dim xmlElmHouseNo As MSXML2.IXMLDOMElement
38Set xmlElmHouseNo = GetFirstElement(xmlElmAddress)
39If xmlElmHouseNo Is Nothing Then
40 Err.Raise -1, "Test", "Missing Person->Address->HouseNo"
41ElseIf xmlElmHouseNo.nodeName <> "HouseNo" Then
42 Err.Raise -1, "Test", "Unexpected element"
43End If
44
45Dim xmlElmPostCode As MSXML2.IXMLDOMElement
46Set xmlElmPostCode = GetNextElement(xmlElmHouseNo)
47If xmlElmPostCode Is Nothing Then
48 Err.Raise -1, "Test", "Missing Person->Address->PostCode"
49ElseIf xmlElmPostCode.nodeName <> "PostCode" Then
50 Err.Raise -1, "Test", "Unexpected element"
51End If
52
53If (GetNextElement(xmlElmPostCode) Is Nothing) = False Then
54 Err.Raise -1, "Test", "Unexpected element"
55End If
56
57Debug.Print xmlElmName.Text & " was born " & _
58 xmlElmDOB.Text & ", and lives at " & _
59 xmlElmHouseNo.Text & ", " & _
60 xmlElmPostCode.Text
61
62Dim xmlElmCar As MSXML2.IXMLDOMElement
63Set xmlElmCar = GetNextElement(xmlElmAddress)
64While (xmlElmCar Is Nothing) = False
65 If xmlElmCar.nodeName <> "Car" Then
66 Err.Raise -1, "Test", "Unexpected element"
67 End If
68
69 Dim xmlElmMake As MSXML2.IXMLDOMElement
70 Set xmlElmMake = GetFirstElement(xmlElmCar)
71 If xmlElmMake Is Nothing Then
72 Err.Raise -1, "Test", "Missing Person->Car->Make"
73 ElseIf xmlElmMake.nodeName <> "Make" Then
74 Err.Raise -1, "Test", "Unexpected element"
75 End If
76
77 Dim xmlElmModel As MSXML2.IXMLDOMElement
78 Set xmlElmModel = GetNextElement(xmlElmMake)
79 If xmlElmModel Is Nothing Then
80 Err.Raise -1, "Test", "Missing Person->Car->Model"
81 ElseIf xmlElmModel.nodeName <> "Model" Then
82 Err.Raise -1, "Test", "Unexpected element"
83 End If
84
85 If (GetNextElement(xmlElmModel) Is Nothing) = False Then
86 Err.Raise -1, "Test", "Unexpected Element"
87 End If
88
89 Debug.Print " " & _
90 xmlElmMake.Text & ", " & _
91 xmlElmModel.Text
92
93 Set xmlElmCar = GetNextElement(xmlElmCar)
94Wend 1Private Function GetFirstElement _
2 (ByVal xmlParent As IXMLDOMNode) As IXMLDOMElement
3 If xmlParent Is Nothing Then
4 Set GetFirstElement = Nothing
5 ElseIf xmlParent.firstChild Is Nothing Then
6 Set GetFirstElement = Nothing
7 ElseIf TypeOf xmlParent.firstChild Is IXMLDOMElement Then
8 Set GetFirstElement = xmlParent.firstChild
9 Else
10 Set GetFirstElement = _
11 GetNextElement(xmlParent.firstChild)
12 End If
13End Function
14
15Private Function GetNextElement _
16 (ByVal xmlNode As IXMLDOMNode) As IXMLDOMElement
17 While (xmlNode Is Nothing) = False
18 Set xmlNode = xmlNode.nextSibling
19 If (xmlNode Is Nothing) = False Then
20 If TypeOf xmlNode Is IXMLDOMElement Then
21 Set GetNextElement = xmlNode
22 Exit Function
23 End If
24 End If
25 Wend
26End Function
|