Working XML parser, efficiency/compatibility

Firstartemis

New Member
Joined
Jun 17, 2015
Messages
10
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.

Code:
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()
         Wend
        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
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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Forum statistics

Threads
1,223,885
Messages
6,175,184
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top