VBA XML Parsing question

Firstartemis

New Member
Joined
Jun 17, 2015
Messages
10
Good Morning,

Thanks to the help of this board and google, I have been able to write the below macro in excel:

Code:
Sub GetFormData()
        Dim XDoc As MSXML2.DOMDocument
        Dim xEmpDetails As MSXML2.IXMLDOMNode
        Dim xEmployee As MSXML2.IXMLDOMNode
        Dim xChild As MSXML2.IXMLDOMNode
        Dim strFolder As String, strFile As String
        Dim WkSht As Worksheet, i As Long, j As Long
            strFolder = GetFolder
            If strFolder = "" Then Exit Sub
            Set WkSht = ActiveSheet
            i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row

            strFile = Dir(strFolder & "\*.xfdf", vbNormal)
        While strFile <> ""
                i = i + 1

        Set XDoc = New MSXML2.DOMDocument
        XDoc.async = False
        XDoc.validateOnParse = False
        XDoc.Load (strFolder & "\" & strFile)
        Set xEmpDetails = XDoc.DocumentElement
        Set xEmployee = xEmpDetails.FirstChild
        j = 0
        For Each xEmployee In xEmpDetails.ChildNodes
        For Each xChild In xEmployee.ChildNodes
        j = j + 1
        WkSht.Cells(i, j) = xChild.Text
        Next xChild
        Next xEmployee

        strFile = Dir()
         Wend
        Application.ScreenUpdating = True

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant

fnd = "Off"
rplc = ""

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht
fnd = "Please type your comments here:"
rplc = ""

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht

ActiveSheet.Range("Table1[#All]").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
ThisWorkbook.RefreshAll
End Sub


        Function GetFolder() As String
        Dim oFolder As Object
        GetFolder = ""
        Set oFolder = CreateObject("Shell.Application").Browseforfolder(0, "Choose a folder ", 0) ''
        If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
        Set oFolder = Nothing
        End Function

It reads a xml file and pastes the values in each cell. However, if the form is left blank it does not record the xml name and the results are no longer aligned. the XML file is below:
Code:
<!--?xml version="1.0" encoding="UTF-8"?-->
<xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve" 
 `?xml version="1.0" encoding="UTF-8"?`
`xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve"
``fields
``field name="1a"
``value
`Murdy`/value
``/field
``field name="1b"
``value
`William`/value
``/field
``field name="1c"
``value
`D`/value
``/field
``field name="1d"
``value
`E7`/value
``/field
``field name="1e"
``value
`william.murdy@fe.navy.mil`/value
``/field
``field name="1f"
``value
`315.243.8942`/value
``/field
``field name="1g"
``value
`61054`/value
``/field
``field name="1h"
``value
`N00R`/value
``/field
``field name="1i"
``value
`Division`/value
``/field
``field name="1j"
``value
`Off`/value
``/field
``field name="2a"
``value
`Christian`/value
``/field
``field name="3a"
``value
`Off`/value
``/field
``field name="4a"
``value
`Off`/value
``/field
``field name="4b"
``value
`Off`/value
``/field
``field name="5a"
``value
`Off`/value
``/field
``field name="5b"
``value
`Off`/value
``/field
``field name="5c"
``value
`X`/value
``/field
``field name="5d"
``value
`Off`/value
``/field
``field name="5e"
``value
`Off`/value
``/field
``field name="5f"
``field name="a"
``value
`Off`/value
``/field
``/field
``field name="6"
``field name="a"
``value
`Off`/value
``/field
``/field
``field name="7"
``field name="a"
``value
`Off`/value
``/field
``/field
``field name="8a"
``value
`Comment`/value
``/field
``field name="Email"
/``/fields
``ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6"
/``/xfdf
`<ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6" 
<xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve" 
<ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6" 
 <xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve" 
<ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6"
The opening and closing tags have been replaced with 'respectively.
How do I assign each field to a column so that the data does not become mismatched? Thank you for your help.</ids></xfdf></ids></xfdf></ids></xfdf>
 
Last edited:

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Firstartemis

New Member
Joined
Jun 17, 2015
Messages
10
The XML isnt display correctly but its form is
<field name="1a"> <value>
Code:
field name="Last Name"
value
Last Name
/value
/field
</value></field>
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,108,525
Messages
5,523,377
Members
409,514
Latest member
MarkZuckerberg

This Week's Hot Topics

Top