jrameuwissen
asked on
Import XML with attributes in childnodes (Ms Access)
Dear Experts,
I'm trying to import an XML file like shown below into an ms access database.
All values should be stored in the same table (SGH_XML_RESPONSE)
Table :
XML_Response_Key (Int, Key, Autonum)
Ordernr (Txt)
Correct_Verwerkt (Txt)
ResultaatCode (Txt)
Omschrijving (Txt)
Response_Text (Memo, (Complete XML file stored as string))
AddDate (Date/Time)
Addwho (Txt)
XML File Example:
<?xml version="1.0" ?>
- <Resultaat>
- <AfmeldResultaat OrderNr="SOR0513073" CorrectVerwerkt="false" ResultaatCode="KlantOngeld ig">
<Omschrijving>Gegevens op de melding SOR0513073 konden niet gevonden worden.</Omschrijving>
</AfmeldResultaat>
- <AfmeldResultaat OrderNr="SOR0513145" CorrectVerwerkt="false" ResultaatCode="GlastypeOng eldig">
<Omschrijving>Glastype iso494 kan niet gevonden worden.</Omschrijving>
</AfmeldResultaat>
</Resultaat>
The problem are the attributes in AfmeldResultaat (Attribute Ordernr, CorrectVerwerkt and ResultaatCode).
Is there somebody who knows how to handle these attributed?
Code so far :
Function Call : fImportXML stXMLResponseString, "SGH_XML_RESPONSE"
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim rst As DAO.Recordset
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
Set xmlNodeList = xmlDOM.getElementsByTagNam e("OrderNr ")
Set rst = CurrentDb.OpenRecordset(st rTableName )
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN ame).Value = xmlNodeField.Text
Next
.Update
Next
.Close
End With
End Function
Any help would be highly appriciated!
Thanks in advance
I'm trying to import an XML file like shown below into an ms access database.
All values should be stored in the same table (SGH_XML_RESPONSE)
Table :
XML_Response_Key (Int, Key, Autonum)
Ordernr (Txt)
Correct_Verwerkt (Txt)
ResultaatCode (Txt)
Omschrijving (Txt)
Response_Text (Memo, (Complete XML file stored as string))
AddDate (Date/Time)
Addwho (Txt)
XML File Example:
<?xml version="1.0" ?>
- <Resultaat>
- <AfmeldResultaat OrderNr="SOR0513073" CorrectVerwerkt="false" ResultaatCode="KlantOngeld
<Omschrijving>Gegevens op de melding SOR0513073 konden niet gevonden worden.</Omschrijving>
</AfmeldResultaat>
- <AfmeldResultaat OrderNr="SOR0513145" CorrectVerwerkt="false" ResultaatCode="GlastypeOng
<Omschrijving>Glastype iso494 kan niet gevonden worden.</Omschrijving>
</AfmeldResultaat>
</Resultaat>
The problem are the attributes in AfmeldResultaat (Attribute Ordernr, CorrectVerwerkt and ResultaatCode).
Is there somebody who knows how to handle these attributed?
Code so far :
Function Call : fImportXML stXMLResponseString, "SGH_XML_RESPONSE"
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim rst As DAO.Recordset
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
Set xmlNodeList = xmlDOM.getElementsByTagNam
Set rst = CurrentDb.OpenRecordset(st
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN
Next
.Update
Next
.Close
End With
End Function
Any help would be highly appriciated!
Thanks in advance
ASKER
Thanks for your reply DrCabbage.
I changed the function but the table is still not populated (also no errors though) :
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim xmlNodeAttribute As IXMLDOMAttribute
Dim rst As DAO.Recordset
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
Set xmlNodeList = xmlDOM.getElementsByTagNam e("Afmeldr esultaat")
Set rst = CurrentDb.OpenRecordset(st rTableName )
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N ame).Value = xmlNodeAttribute.Value
Next
.Fields(xmlNodeField.nodeN ame).Value = xmlNodeField.Text
Next
.Update
Next
.Close
End With
End Function
Is there something I'm missing?
Thanks.
I changed the function but the table is still not populated (also no errors though) :
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim xmlNodeAttribute As IXMLDOMAttribute
Dim rst As DAO.Recordset
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
Set xmlNodeList = xmlDOM.getElementsByTagNam
Set rst = CurrentDb.OpenRecordset(st
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N
Next
.Fields(xmlNodeField.nodeN
Next
.Update
Next
.Close
End With
End Function
Is there something I'm missing?
Thanks.
Sorry, I should have been clearer exactly where to put the second "For Each".
Because the attributes are on the outer node, that's what the foreach should be on - if you nest it as you have done, you're looping through the attributes on each child node (but the child nodes have no attributes). What I meant was to have a second foreach - after looping through the child nodes of AfmeldResultaat, we loop through the attributes of AfmeldResultaat:
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN ame).Value = xmlNodeField.Text
Next
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N ame).Value = xmlNodeAttribute.Value
Next
.Update
Next
.Close
End With
Because the attributes are on the outer node, that's what the foreach should be on - if you nest it as you have done, you're looping through the attributes on each child node (but the child nodes have no attributes). What I meant was to have a second foreach - after looping through the child nodes of AfmeldResultaat, we loop through the attributes of AfmeldResultaat:
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN
Next
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N
Next
.Update
Next
.Close
End With
ASKER
DrCabbage,
I must be missing something. I'm still not able to populate the table.
Still no errormessage occures...
Any ideas? Thanks in advance!
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim xmlNodeAttribute As IXMLDOMAttribute
Dim rst As DAO.Recordset
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
Set xmlNodeList = xmlDOM.getElementsByTagNam e("AfmeldR esultaat")
Set rst = CurrentDb.OpenRecordset(st rTableName )
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN ame).Value = xmlNodeField.Text
Next
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N ame).Value = xmlNodeAttribute.Value
Next
.Update
Next
.Close
End With
End Function
I must be missing something. I'm still not able to populate the table.
Still no errormessage occures...
Any ideas? Thanks in advance!
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim xmlNodeAttribute As IXMLDOMAttribute
Dim rst As DAO.Recordset
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
Set xmlNodeList = xmlDOM.getElementsByTagNam
Set rst = CurrentDb.OpenRecordset(st
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN
Next
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N
Next
.Update
Next
.Close
End With
End Function
ASKER
Could it be the getElementsByTagName tag (Afmeldresultaat) is incorrect?
Or maybe the string I pass to the function? The string consists out of the innertext element of the webbrowser....
Or maybe the string I pass to the function? The string consists out of the innertext element of the webbrowser....
It might be useful to set a breakpoint after the line
Set xmlNodeList = xmlDOM.getElementsByTagNam e("AfmeldR esultaat")
and just check with the debugger that xmlNodeList has some entries (you can navigate through the DOM this way, which I've found very helpful for spotting bugs.
It might also be an idea to add a little error-checking code in case there is something wrong with the XML, for example :
xmlDOM.LoadXML strXML
If (xmlDOM.parseError.errorCo de <> 0) Then
Dim myErr
Set myErr = xmlDOM.parseError
MsgBox("An XML Parse error occurred: " & myErr.reason)
End If
Set xmlNodeList = xmlDOM.getElementsByTagNam
and just check with the debugger that xmlNodeList has some entries (you can navigate through the DOM this way, which I've found very helpful for spotting bugs.
It might also be an idea to add a little error-checking code in case there is something wrong with the XML, for example :
xmlDOM.LoadXML strXML
If (xmlDOM.parseError.errorCo
Dim myErr
Set myErr = xmlDOM.parseError
MsgBox("An XML Parse error occurred: " & myErr.reason)
End If
ASKER
Thanks DrCabbage,
I added your code :
If (xmlDOM.parseError.errorCo de <> 0) Then
Dim myErr
Set myErr = xmlDOM.parseError
MsgBox("An XML Parse error occurred: " & myErr.reason)
End If
I receive errormessage : Invalid XML Declaration...
Any ideas?
I added your code :
If (xmlDOM.parseError.errorCo
Dim myErr
Set myErr = xmlDOM.parseError
MsgBox("An XML Parse error occurred: " & myErr.reason)
End If
I receive errormessage : Invalid XML Declaration...
Any ideas?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
DrCabbage, you nailed it!!! I changed the code (see below) and it works just fine now!
Removing the <?xml line made it work.
Dim replaceLine As String
stXMLResponseString = Innertext
stXMLResponseString = Replace(stXMLResponseStrin g, "-", "")
replaceLine = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " ?>"
stXMLResponseString = Replace(stXMLResponseStrin g, replaceLine, "")
fImportXML stXMLResponseString2, "SGH_XML_Response"
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim xmlNodeAttribute As IXMLDOMAttribute
Dim rst As DAO.Recordset
Dim errordesc As String
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
If (xmlDOM.parseError.ErrorCo de <> 0) Then
Dim myErr
Set myErr = xmlDOM.parseError
MsgBox ("An XML Parse error occurred: " & myErr.reason)
errordesc = "Application encountered an Error while trying to import XML response from Meldkamer in Function [fImportXML]" & vbNewLine & myErr
Call ErrorLogging(errordesc, "IMPORT RESPONSE", Err.Number, Err.Description)
Exit Function
End If
Set xmlNodeList = xmlDOM.getElementsByTagNam e("AfmeldR esultaat")
Set rst = CurrentDb.OpenRecordset(st rTableName )
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN ame).Value = xmlNodeField.Text
Next
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N ame).Value = xmlNodeAttribute.Value
Next
rst.Fields("Response_Text" ) = strXML
.Update
Next
.Close
End With
End Function
Thanks a lot for your help!
Points rewarded of course.
Removing the <?xml line made it work.
Dim replaceLine As String
stXMLResponseString = Innertext
stXMLResponseString = Replace(stXMLResponseStrin
replaceLine = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " ?>"
stXMLResponseString = Replace(stXMLResponseStrin
fImportXML stXMLResponseString2, "SGH_XML_Response"
Function fImportXML(strXML As String, strTableName As String)
Dim xmlDOM As DOMDocument
Dim xmlNodeList As IXMLDOMNodeList
Dim xmlNodeItem As IXMLDOMNode
Dim xmlNodeField As IXMLDOMNode
Dim xmlNodeAttribute As IXMLDOMAttribute
Dim rst As DAO.Recordset
Dim errordesc As String
Set xmlDOM = New DOMDocument
xmlDOM.LoadXML strXML
If (xmlDOM.parseError.ErrorCo
Dim myErr
Set myErr = xmlDOM.parseError
MsgBox ("An XML Parse error occurred: " & myErr.reason)
errordesc = "Application encountered an Error while trying to import XML response from Meldkamer in Function [fImportXML]" & vbNewLine & myErr
Call ErrorLogging(errordesc, "IMPORT RESPONSE", Err.Number, Err.Description)
Exit Function
End If
Set xmlNodeList = xmlDOM.getElementsByTagNam
Set rst = CurrentDb.OpenRecordset(st
With rst
For Each xmlNodeItem In xmlNodeList
.AddNew
For Each xmlNodeField In xmlNodeItem.ChildNodes
.Fields(xmlNodeField.nodeN
Next
For Each xmlNodeAttribute In xmlNodeItem.Attributes
.Fields(xmlNodeAttribute.N
Next
rst.Fields("Response_Text"
.Update
Next
.Close
End With
End Function
Thanks a lot for your help!
Points rewarded of course.
ASKER
Oeps, the function call should be
fImportXML stXMLResponseString, "SGH_XML_Response"
Regards, Johan
fImportXML stXMLResponseString, "SGH_XML_Response"
Regards, Johan
For Each xmlNodeAttribute In xmlNodeItem.attributes
.Fields(xmlNodeAttribute.N
Next