Working XML parser, efficiency/compatibility


New Member
Jun 17, 2015
Good Morning Mr. Excel,

I've written a working xml parser macro that processes an emailed adobe survey. It uses early binding of the MSXML library and seems to work as intended. I guess I'm requesting feedback on if there is a more efficient way to code and I'd like to make sure its compatible with both 32 and 64 bit excel platforms. The original macro pulled all the survey responses, but we found that the adobe survey will not include an xml entry if the answer is blank leaving mismatched entries in the spreadsheet. Our spreadsheet is in Table format to help us create pivot tables and charts from the data.

My main concern is compatibility and efficiency, however, if you know how to integrate Microsoft Outlook into the macro, I'm open to suggestions. The current process is to manually move the attachment from an email and rename it as unique file name. Thank you for your suggestions.

Sub ProcessRNA()
    Dim XDoc As New MSXML2.DOMDocument
    Dim xmlNodelist As MSXML2.IXMLDOMNodeList
    Dim WkSht As Worksheet, i As Long
    Dim strFolder As String, strFile As String
    Dim sht As Worksheet
    Dim fnd As Variant
    Dim rplc As Variant
        'Choose folder where .xml files are kept
            strFolder = GetFolder
            If strFolder = "" Then Exit Sub
            Set WkSht = ActiveSheet
            'Finds last row
            i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row

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

        XDoc.async = False
        XDoc.validateOnParse = False
        XDoc.Load (strFolder & "\" & strFile)
        On Error Resume Next
        WkSht.Cells(i, 1) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1a']")(0).Text
        WkSht.Cells(i, 2) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1b']")(0).Text
        WkSht.Cells(i, 3) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1c']")(0).Text
        WkSht.Cells(i, 4) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1d']")(0).Text
        WkSht.Cells(i, 5) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1e']")(0).Text
        WkSht.Cells(i, 6) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1f']")(0).Text
        WkSht.Cells(i, 7) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1g']")(0).Text
        WkSht.Cells(i, 8) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1h']")(0).Text
        WkSht.Cells(i, 9) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1i']")(0).Text
        WkSht.Cells(i, 10) = XDoc.DocumentElement.SelectNodes("fields/field[@name='1j']")(0).Text
        WkSht.Cells(i, 11) = XDoc.DocumentElement.SelectNodes("fields/field/field[@name='a']")(0).Text
        WkSht.Cells(i, 12) = XDoc.DocumentElement.SelectNodes("fields/field[@name='2b']")(0).Text
        WkSht.Cells(i, 13) = XDoc.DocumentElement.SelectNodes("fields/field[@name='3']")(0).Text
        WkSht.Cells(i, 14) = XDoc.DocumentElement.SelectNodes("fields/field[@name='4a']")(0).Text
        WkSht.Cells(i, 15) = XDoc.DocumentElement.SelectNodes("fields/field[@name='4b']")(0).Text
        WkSht.Cells(i, 16) = XDoc.DocumentElement.SelectNodes("fields/field[@name='5a']")(0).Text
        WkSht.Cells(i, 17) = XDoc.DocumentElement.SelectNodes("fields/field[@name='5b']")(0).Text
        WkSht.Cells(i, 18) = XDoc.DocumentElement.SelectNodes("fields/field[@name='5c']")(0).Text
        WkSht.Cells(i, 19) = XDoc.DocumentElement.SelectNodes("fields/field[@name='5d']")(0).Text
        WkSht.Cells(i, 20) = XDoc.DocumentElement.SelectNodes("fields/field[@name='5e']")(0).Text
        WkSht.Cells(i, 21) = XDoc.DocumentElement.SelectNodes("fields/field[@name='5f']")(0).Text
        WkSht.Cells(i, 22) = XDoc.DocumentElement.SelectNodes("fields/field[@name='6']")(0).Text
        WkSht.Cells(i, 23) = XDoc.DocumentElement.SelectNodes("fields/field[@name='7']")(0).Text
        WkSht.Cells(i, 24) = XDoc.DocumentElement.SelectNodes("fields/field[@name='8a']")(0).Text
        strFile = Dir()
        Application.ScreenUpdating = True

'Declutters Excel File

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

'Removes duplicates
ActiveSheet.Range("Table1[#All]").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes

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

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics