Sub XMLRead()
DoCmd.SetWarnings False
Dim path As String
Dim firstNameField As MSXML2.IXMLDOMNodeList
Dim lists As MSXML2.IXMLDOMNodeList
Dim raml As MSXML2.IXMLDOMElement
Dim RETU_R_Fields As Variant
Dim RETU_R_Values As Variant
Dim Fieldname As String
Dim i As Integer
path = "C:\Audit_DB\Input Files\Test.xml"
'Delete all records from Table RETU_R
DoCmd.RunSQL "Delete * from RETU_R"
Dim ObjXMLDoc As MSXML2.DOMDocument60
Set ObjXMLDoc = New MSXML2.DOMDocument60
ObjXMLDoc.async = False
ObjXMLDoc.SetProperty "SelectionLanguage", "XPath"
ObjXMLDoc.SetProperty "ProhibitDTD", False
ObjXMLDoc.resolveExternals = False
ObjXMLDoc.validateOnParse = False
ObjXMLDoc.SetProperty "SelectionNamespaces", "xmlns:r='raml20.xsd'"
ObjXMLDoc.Load (path)
If ObjXMLDoc.parseError.errorCode <> 0 Then
MsgBox "ERROR when loading " + strFileName + ": " + ObjXMLDoc.parseError.reason
Else
'MsgBox "Loaded Successfully"
End If
Set objDoc = ObjXMLDoc.documentElement
Dim TitleNodes As MSXML2.IXMLDOMNodeList
Set TitleNodes = ObjXMLDoc.selectNodes("//r:managedObject")
Dim NodeElement As MSXML2.IXMLDOMElement
Dim nodeChild As IXMLDOMElement
Dim mo As String
Dim DN_Name As String
Dim p_name As String
Dim p_value As String
Dim l_name As String
For Each node In TitleNodes
mo = node.getAttribute("class")
If mo = "RETU_R" Then
DN_Name = node.getAttribute("distName")
For Each par In node.childNodes
If par.baseName = "p" Then
p_name = par.getAttribute("name")
p_value = par.Text
End If
If par.baseName = "list" Then
l_name = par.getAttribute("name")
For Each list In par.childNodes
If list.baseName = "item" Then
For Each itemp In list.childNodes
p_name = l_name & "_" & itemp.getAttribute("name")
If itemp.baseName = "p" Then
p_value = itemp.Text
End If
Next
End If
Next
End If
'Debug.Print p_name, DN_Name, p_value
Call RETU_R_Update(p_name, p_value, DN_Name)
Next
End If
Next
MsgBox "XML is Loaded Successfully"
Debug.Print ObjXMLDoc.selectNodes("//r:managedObject").length
DoCmd.SetWarnings True
End Sub