Excel VBA CreateObject("Scripting.FileSystemObject") auf Netzlaufwerk dauert ewig

Set objFSO = CreateObject("Scripting.FileSystemObject")  
        Set objdir = objFSO.getfolder(Pfad)
        dirInfo objdir, Datei, True 'inkl. Unterordner  

Public Sub dirInfo(ByVal objCurrentDir As Object, ByVal strName As String, _
    Optional ByVal blnTMP As Boolean = False)
    Dim varTMP As Variant
    For Each varTMP In objCurrentDir.Files
        If varTMP.Name Like strName Then
            If varTMP.Name <> ActiveWorkbook.Name Then
                If Left(varTMP.Name, 1) <> "~" Then  
                    TempPfad = varTMP.ParentFolder.Path
                    ' Hier jetzt der Code um mit der Datei etwas zu machen  
                    ' z. B. Öffnen, etwas auslesen oder was auch immer...  
                    If ActiveWorkbook.Name = ODatei Then
                        ReDim Preserve Strlist(0 To 1, lngCount)
                        Strlist(0, lngCount) = varTMP.Name
                        Strlist(1, lngCount) = varTMP.Path
                        lngCount = lngCount + 1
                    End If
                    Exit For
                End If
            End If
        End If
    Next varTMP
    If blnTMP = True Then
        For Each varTMP In objCurrentDir.SubFolders
            dirInfo varTMP, strName, blnTMP
        Next varTMP
    End If
End Sub