Need help with VBA MSXML2 DOMDocument syntax to modify Infopath xml form root element data.

Option Explicit
 
Public Sub XMLTest()
 
Dim strNewFormName As String
strNewFormName = Me.Request.Value
 
Dim xmldoc As MSXML2.DOMDocument
Set xmldoc = New MSXML2.DOMDocument
Call xmldoc.Load("C:\Users\Phil Millington-Hore\Documents\Programming\Visual Basic\ADL\Golds\DelOptiChaR\XML\2002_01.xml")  'load an existing Infopath form linked to underlying Access DB
 
'xmldoc. need syntax to manipulate xml document root element data to match currently open Access form fields
Call XmlReader(xmldoc.DocumentElement)
 
If Len(Dir("C:\PhilAI\test.xml")) > 0 Then Call Kill("C:\PhilAI\test.xml")
Call xmldoc.Save("C:\PhilAI\test.xml")  'save modified file to known location
Set xmldoc = Nothing 'clear xmldoc parameters
 
End Sub
 
Public Sub XmlReader(ByRef domRoot As Object)
 
Dim currentNode As IXMLDOMNode
Dim rootNode As IXMLDOMNode
 
On Error GoTo ERR_HANDLER
 
If TypeOf domRoot Is IXMLDOMNode Then
    Set rootNode = domRoot
Else
    GoTo PROCEDURE_EXIT
End If
 
For Each currentNode In rootNode.ChildNodes
    Debug.Print currentNode.nodeName
    If currentNode.ChildNodes.Length > 0 Then
        Call XmlReader(currentNode)
    End If
Next
 
PROCEDURE_EXIT:
Set currentNode = Nothing
Set rootNode = Nothing
 
Exit Sub
 
ERR_HANDLER:
Debug.Print "Error #" & Err.Number & ": " & Err.Description
Resume PROCEDURE_EXIT
 
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:

<?xml version="1.0" encoding="UTF-8"?><?mso-infoPathSolution solutionVersion="1.0.0.15" productVersion="12.0.0" PIVersion="1.0.0.0" href="file:///C:\Documents%20and%20Settings\qzsj4g\My%20Documents\test3.xsn" name="urn:schemas-microsoft-com:office:infopath:test3:-dataFormSolution" initialView="View 1" ?><?mso-application progid="InfoPath.Document" versionProgid="InfoPath.Document.2"?><dfs:myFields xmlns:q="http://schemas.microsoft.com/office/infopath/2003/ado/queryFields" xmlns:d="http://schemas.microsoft.com/office/infopath/2003/ado/dataFields" xmlns:dfs="http://schemas.microsoft.com/office/infopath/2003/dataFormSolution" xmlns:my="http://schemas.microsoft.com/office/infopath/2003/myXSD/2009-08-17T16:50:44" xmlns:xdado="http://schemas.microsoft.com/office/infopath/2003/adomapping" xml:lang="en-us">
<dfs:dataFields>
<d:tblWrkRqst request="3" description="testing" fab_area="jobshop" accept="False" xdado:OEltUe="0"/>
</dfs:dataFields>
<xdado:originalData IdCount="1"><xml xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882" xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882" xmlns:rs="urn:schemas-microsoft-com:rowset" xmlns:z="#RowsetSchema"><s:Schema id="RowsetSchema"><s:ElementType content="eltOnly" rs:updatable="true" name="tblWrkRqst"><s:AttributeType rs:number="1" rs:maydefer="true" rs:writeunknown="true" rs:basetable="tblWrkRqst" rs:basecolumn="request" rs:keycolumn="true" rs:autoincrement="true" name="request"><s:datatype dt:type="int" dt:maxLength="4" rs:precision="10" rs:fixedlength="true"/></s:AttributeType><s:AttributeType rs:number="2" rs:nullable="true" rs:maydefer="true" rs:writeunknown="true" rs:basetable="tblWrkRqst" rs:basecolumn="description" name="description"><s:datatype dt:type="string" dt:maxLength="50"/></s:AttributeType><s:AttributeType rs:number="3" rs:nullable="true" rs:maydefer="true" rs:writeunknown="true" rs:basetable="tblWrkRqst" rs:basecolumn="fab area" name="fab_area"><s:datatype dt:type="string" dt:maxLength="50"/></s:AttributeType><s:AttributeType rs:number="4" rs:maydefer="true" rs:writeunknown="true" rs:basetable="tblWrkRqst" rs:basecolumn="accept" name="accept"><s:datatype dt:type="boolean" dt:maxLength="2" rs:fixedlength="true"/></s:AttributeType><s:extends type="rs:rowbase"/></s:ElementType></s:Schema><rs:data><tblWrkRqst request="3" description="testing" fab_area="jobshop" accept="False" xdado:OEltUe="0"/></rs:data></xml></xdado:originalData></dfs:myFields>
                                              

1:
2:
3:
4:
5:

Private Sub btnInfopathForm_Click()
Dim strFormName As String
Dim strWorkRequest As String
strWorkRequest = Me.Request.value
strFormName = "Work Request" & "-" & strWorkRequest 'Define new form name
Dim objIP As Object
 
Set objIP = CreateObject("InfoPath.Application")
Dim xmldoc As MSXML2.DOMDocument
Set xmldoc = New MSXML2.DOMDocument
xmldoc.Load ("C:\TEMP\infopath tests\WRtest1.xml") 'load base form
Call UpdateInfoPathXml(xmldoc.documentElement) 'modify base form attribute data to match open form data
xmldoc.Save ("C:\TEMP\infopath tests\" & strFormName & ".xml") 'save modified xml file to known location
Set xmldoc = Nothing 'clear xmldoc parameters
End Sub
 
Public Sub UpdateInfoPathXml(ByRef domRoot As Object)
Dim currentNode As IXMLDOMNode
Dim rootNode As IXMLDOMNode
On Error GoTo ERR_HANDLER
 
If TypeOf domRoot Is IXMLDOMNode Then
    Set rootNode = domRoot
Else
    GoTo PROCEDURE_EXIT
End If
 
Dim varNodeName
For Each currentNode In rootNode.childNodes
If Not currentNode.Attributes Is Nothing Then
        If currentNode.Attributes.length > 0 Then
            For I = 0 To currentNode.Attributes.length - 1
                Set currentAttribute = currentNode.Attributes.Item(I)
                varNodeName = currentAttribute.nodeName
                Select Case varNodeName
                Case "request"
                    currentAttribute.Text = Me.[Request].value
                Case "description"
                    currentAttribute.Text = Me.[description].value
                Case "accept" 'boolean value
                    If Me.[Accept].value = 0 Then
                        currentAttribute.Text = "False"
                        Else
                        currentAttribute.Text = "True"
                    End If
                Case "fab_Area"
                    currentAttribute.Text = Me.[fab_area].value
                End Select
                Next
            End If
        End If
     If currentNode.childNodes.length > 0 Then
        Call UpdateInfoPathXml(currentNode)
    End If
Next
 
PROCEDURE_EXIT:
Set currentAttribute = Nothing
Set currentNode = Nothing
Set rootNode = Nothing
 
Exit Sub
 
ERR_HANDLER:
Debug.Print "Error #" & Err.Number & ": " & Err.description
Resume PROCEDURE_EXIT
 
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:

Option Explicit
 
Public Sub btnInfopathForm_Click()
 
'Dim objIP As Object
Dim strFormName As String
Dim strWorkRequest As String
 
strWorkRequest = Me.Request.Value
strFormName = "Work Request" & "-" & strWorkRequest 'Define new form name
 
'Set objIP = CreateObject("InfoPath.Application")
Dim xmldoc As MSXML2.DOMDocument
Set xmldoc = New MSXML2.DOMDocument
 
Call xmldoc.Load("C:\TEMP\infopath tests\WRtest1.xml")  'load base form
'Call UpdateInfoPathXml(xmldoc.DocumentElement) 'modify base form attribute data to match open form data
Call UpdateWorkRequest(xmldoc) 'modify base form attribute data to match open form data
Call xmldoc.Save("C:\TEMP\infopath tests\" & strFormName & ".xml")  'save modified xml file to known location
 
Set xmldoc = Nothing 'clear xmldoc parameters
'Set objIP = Nothing
 
End Sub
 
Public Sub UpdateWorkRequest(ByRef domRoot As Object)
 
Dim currentAttribute As IXMLDOMNode
Dim currentNode As IXMLDOMNode
 
With domRoot.DocumentElement
    ' Request
    Set currentNode = .SelectSingleNode("/dfs:myFields/dfs:dataFields/d:tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("request")
    currentAttribute.text = Me.[Request].Value
    Set currentNode = .SelectSingleNode("/dfs:myFields/xdado:originalData/xml/rs:data/tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("request")
    currentAttribute.text = Me.[Request].Value
    ' Description
    Set currentNode = .SelectSingleNode("/dfs:myFields/dfs:dataFields/d:tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("description")
    currentAttribute.text = Me.[Description].Value
    Set currentNode = .SelectSingleNode("/dfs:myFields/xdado:originalData/xml/rs:data/tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("description")
    currentAttribute.text = Me.[Description].Value
    ' Accept
    Set currentNode = .SelectSingleNode("/dfs:myFields/dfs:dataFields/d:tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("accept")
    currentAttribute.text = CStr(CBool(Me.[Accept].Value))
    Set currentNode = .SelectSingleNode("/dfs:myFields/xdado:originalData/xml/rs:data/tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("accept")
    currentAttribute.text = CStr(CBool(Me.[Accept].Value))
    ' FAB area
    Set currentNode = .SelectSingleNode("/dfs:myFields/dfs:dataFields/d:tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("fab_area")
    currentAttribute.text = Me.[fab_area].Value
    Set currentNode = .SelectSingleNode("/dfs:myFields/xdado:originalData/xml/rs:data/tblWrkRqst")
    Set currentAttribute = currentNode.Attributes.getNamedItem("fab_area")
    currentAttribute.text = Me.[fab_area].Value
End With
 
Set currentAttribute = Nothing
Set currentNode = Nothing
 
End Sub
 
 
Public Sub UpdateInfoPathXml(ByRef domRoot As Object)
 
Dim rootNode As IXMLDOMNode
On Error GoTo ERR_HANDLER
 
If TypeOf domRoot Is IXMLDOMNode Then
    Set rootNode = domRoot
Else
    GoTo PROCEDURE_EXIT
End If
 
Dim varNodeName
For Each currentNode In rootNode.ChildNodes
If Not currentNode.Attributes Is Nothing Then
        If currentNode.Attributes.Length > 0 Then
            For I = 0 To currentNode.Attributes.Length - 1
                Set currentAttribute = currentNode.Attributes.Item(I)
                varNodeName = currentAttribute.nodeName
                Select Case varNodeName
                Case "request"
                    currentAttribute.text = Me.[Request].Value
                Case "description"
                    currentAttribute.text = Me.[Description].Value
                Case "accept" 'boolean value
                    If Me.[Accept].Value = 0 Then
                        currentAttribute.text = "False"
                        Else
                        currentAttribute.text = "True"
                    End If
                Case "fab_Area"
                    currentAttribute.text = Me.[fab_area].Value
                End Select
                Next
            End If
        End If
     If currentNode.ChildNodes.Length > 0 Then
        Call UpdateInfoPathXml(currentNode)
    End If
Next
 
PROCEDURE_EXIT:
Set currentAttribute = Nothing
Set currentNode = Nothing
Set rootNode = Nothing
 
Exit Sub
 
ERR_HANDLER:
Debug.Print "Error #" & Err.Number & ": " & Err.Description
Resume PROCEDURE_EXIT
 
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119: