excel vba - type mismatch and optimise
![b][1]

Here is my code basically when you run it asks for input of xml files then you select some and it generates the values of the xpaths from the first sheet. See screenshot above for before it is run and screenhot at the bottom for after it is run.

It works fine when I select just a few xmls as input at the file dialog but sometimes if I select many files (such as over 1000) it spawns a 'Type mismatch error' and the Results sheet remains blank. This error seems to be intermittent and not related to the data, not sure if having other spreadsheets at the same time could cause it. I'm raking over the code but have no idea what is causing the error. Note, i'm already using Option Explicit.

    Public Sub copybyFile()
    Dim aDoc As DOMDocument
    Dim aNode As IXMLDOMNode
    Dim numOfXpaths As Integer
    Dim tagOccurrences As Integer
    Dim filenames As Variant
    Dim f As Integer
    Dim maxcol As String
    Dim c As Range
    Dim aNodes As IXMLDOMNodeList
    
    filenames = Application.GetOpenFilename(MultiSelect:=True)
    numOfXpaths = colToRow + 1
    f = 1
    maxcol = Number2Char(numOfXpaths)
    
    For f = 1 To UBound(filenames)
            aDoc.Load (filenames(f))
        For Each c In Worksheets("Results").Range("A1:" & maxcol & "1")
            If c.Value <> "" Then
                tagOccurrences = 0
                On Error Resume Next
                Set aNodes = aDoc.selectNodes(c.Value)
                If aNodes.Length > 0 Then 'if at least one node of the xpath is present
                    For Each aNode In aNodes 'loop thru each occurence of a node
                        If tagOccurrences = 0 Then 'first occurence of tag
                            'tagValue = aNode.Text
                            'MsgBox aNode.Text
                                c.Offset(f, 0).Value = aNode.Text
                        End If
                        tagOccurrences = tagOccurrences + 1
                    Next
                End If
            End If
            Set aNodes = Nothing
            'Set tagValue = Nothing
        Next c
        Worksheets("Results").Range(maxcol & "1").Offset(f, 0).Value = filenames(f)
    Next f
    End Sub
      
    Function Number2Char(ByVal c) As String
    Number2Char = Split(Cells(1, c).Address, "$")(1)
    End Function
    
    Function colToRow()
    Dim xpathcount As Integer
    Dim c As Integer
    'Dim colToRow As Integer
    xpathcount = Worksheets("Xpaths").Cells(Rows.Count, "A").End(xlUp).Row - 1
    For c = 0 To xpathcount
        Worksheets("Results").Range("A1").Offset(0, c) = Worksheets("Xpaths").Range("A1").Offset(c, 0)
        Worksheets("Results").Range("A1").Offset(0, c).Columns.AutoFit
    Next c
    Worksheets("Results").Range("A1").Offset(0, xpathcount + 1) = "Filename"
    colToRow = xpathcount + 1
    End Function

![a][2]

Big props if you are able to optimise the performance using array/transpose or otherwise.


  [1]: http://i.stack.imgur.com/3w1Yb.jpg
  [2]: http://i.stack.imgur.com/do32y.jpg
excel vba - type mismatch and optimise
===

![b][1]

Here is my code basically when you run it asks for input of xml files then you select some and it generates the values of the xpaths from the first sheet. See screenshot above for before it is run and screenhot at the bottom for after it is run.

It works fine when I select just a few xmls as input at the file dialog but sometimes if I select many files (such as over 1000) it spawns a 'Type mismatch error' and the Results sheet remains blank. This error seems to be intermittent and not related to the data, not sure if having other spreadsheets at the same time could cause it. I'm raking over the code but have no idea what is causing the error. Note, i'm already using Option Explicit.

    Public Sub copybyFile()
    Dim aDoc As DOMDocument
    Dim aNode As IXMLDOMNode
    Dim numOfXpaths As Integer
    Dim tagOccurrences As Integer
    Dim filenames As Variant
    Dim f As Integer
    Dim maxcol As String
    Dim c As Range
    Dim aNodes As IXMLDOMNodeList
    
    filenames = Application.GetOpenFilename(MultiSelect:=True)
    numOfXpaths = colToRow + 1
    f = 1
    maxcol = Number2Char(numOfXpaths)
    
    For f = 1 To UBound(filenames)
            aDoc.Load (filenames(f))
        For Each c In Worksheets("Results").Range("A1:" & maxcol & "1")
            If c.Value <> "" Then
                tagOccurrences = 0
                On Error Resume Next
                Set aNodes = aDoc.selectNodes(c.Value)
                If aNodes.Length > 0 Then 'if at least one node of the xpath is present
                    For Each aNode In aNodes 'loop thru each occurence of a node
                        If tagOccurrences = 0 Then 'first occurence of tag
                            'tagValue = aNode.Text
                            'MsgBox aNode.Text
                                c.Offset(f, 0).Value = aNode.Text
                        End If
                        tagOccurrences = tagOccurrences + 1
                    Next
                End If
            End If
            Set aNodes = Nothing
            'Set tagValue = Nothing
        Next c
        Worksheets("Results").Range(maxcol & "1").Offset(f, 0).Value = filenames(f)
    Next f
    End Sub
      
    Function Number2Char(ByVal c) As String
    Number2Char = Split(Cells(1, c).Address, "$")(1)
    End Function
    
    Function colToRow()
    Dim xpathcount As Integer
    Dim c As Integer
    'Dim colToRow As Integer
    xpathcount = Worksheets("Xpaths").Cells(Rows.Count, "A").End(xlUp).Row - 1
    For c = 0 To xpathcount
        Worksheets("Results").Range("A1").Offset(0, c) = Worksheets("Xpaths").Range("A1").Offset(c, 0)
        Worksheets("Results").Range("A1").Offset(0, c).Columns.AutoFit
    Next c
    Worksheets("Results").Range("A1").Offset(0, xpathcount + 1) = "Filename"
    colToRow = xpathcount + 1
    End Function

![a][2]

Big props if you are able to optimise the performance using array/transpose or otherwise.


  [1]: http://i.stack.imgur.com/3w1Yb.jpg
  [2]: http://i.stack.imgur.com/do32y.jpg