Dateien in einem Ordner mit VBA durchlaufen?

236

Ich möchte die Dateien eines Verzeichnisses mit durchlaufen in Excel 2010.

In der Schleife brauche ich:

  • den Dateinamen und
  • das Datum, an dem die Datei formatiert wurde.

Ich habe Folgendes codiert, was gut funktioniert, wenn der Ordner nicht mehr als 50 Dateien enthält, andernfalls ist es lächerlich langsam (ich brauche es, um mit Ordnern mit> 10000 Dateien zu arbeiten). Das einzige Problem dieses Codes besteht darin, dass das Nachschlagen file.nameextrem lange dauert.

Code, der funktioniert, aber waaaaaay zu langsam ist (15 Sekunden pro 100 Dateien):

Sub LoopThroughFiles()
   Dim MyObj As Object, MySource As Object, file As Variant
   Set MySource = MyObj.GetFolder("c:\testfolder\")
   For Each file In MySource.Files
      If InStr(file.name, "test") > 0 Then
         MsgBox "found"
         Exit Sub
      End If
   Next file
End Sub

Problem gelöst:

  1. Mein Problem wurde durch die folgende Lösung gelöst, indem Dirauf bestimmte Weise (20 Sekunden für 15000 Dateien) und zum Überprüfen des Zeitstempels mit dem Befehl FileDateTime.
  2. Unter Berücksichtigung einer anderen Antwort von unterhalb der 20 Sekunden wird auf weniger als 1 Sekunde reduziert.
Tyrex
quelle
Ihre anfängliche Zeit scheint für VBA immer noch langsam zu sein. Verwenden Sie Application.ScreenUpdating = false?
Michiel van der Blonk
2
Sie scheinen zu fehlen codeSet MyObj = New FileSystemObject
baldmosher
13
Ich finde es ziemlich traurig, dass die Leute das BFS schnell als "langsam" bezeichnen, aber niemand erwähnt die Leistungseinbußen, die Sie vermeiden könnten, wenn Sie einfach eine frühe Bindung anstelle von spät gebundenen Anrufen verwenden Object.
Mathieu Guindon

Antworten:

46

Hier ist meine Interpretation als Funktion:

'#######################################################################
'# LoopThroughFiles
'# Function to Loop through files in current directory and return filenames
'# Usage: LoopThroughFiles ActiveWorkbook.Path, "txt" 'inputDirectoryToScanForFile
'# /programming/10380312/loop-through-files-in-a-folder-using-vba
'#######################################################################
Function LoopThroughFiles(inputDirectoryToScanForFile, filenameCriteria) As String

    Dim StrFile As String
    'Debug.Print "in LoopThroughFiles. inputDirectoryToScanForFile: ", inputDirectoryToScanForFile

    StrFile = Dir(inputDirectoryToScanForFile & "\*" & filenameCriteria)
    Do While Len(StrFile) > 0
        Debug.Print StrFile
        StrFile = Dir

    Loop

End Function
benmichae2.
quelle
25
Warum funktionieren, wenn nichts zurückgegeben wird? ist nicht dasselbe wie die Antwort von brettdj, außer dass sie in einer Funktion eingeschlossen ist
Shafeek
253

DirNimmt Platzhalter, damit Sie einen großen Unterschied machen können, indem Sie den Filter für testdie Vorderseite hinzufügen und vermeiden, jede Datei zu testen

Sub LoopThroughFiles()
    Dim StrFile As String
    StrFile = Dir("c:\testfolder\*test*")
    Do While Len(StrFile) > 0
        Debug.Print StrFile
        StrFile = Dir
    Loop
End Sub
brettdj
quelle
29
GROSSARTIG. Dies hat gerade die Laufzeit von 20 Sekunden auf <1 Sekunden verbessert. Das ist eine große Verbesserung, da der Code ziemlich oft ausgeführt wird. DANKE!!
Tyrex
Es könnte sein, dass die Do while ... -Schleife besser ist als while ... wend. Weitere Infos hier stackoverflow.com/questions/32728334/…
Hila DG
6
Ich denke nicht an diese Verbesserungsstufe (20 - xxx mal) - ich denke, es ist der Platzhalter, der einen Unterschied macht.
Brettdj
DIR () scheint keine versteckten Dateien zurückzugeben.
Hamish
@hamish, Sie können das Argument ändern, um verschiedene Dateitypen (versteckt, System usw.) zurückzugeben - siehe MS-Dokumentation: docs.microsoft.com/en-us/office/vba/language/reference/…
Vincent
158

Dir scheint sehr schnell zu sein.

Sub LoopThroughFiles()
    Dim MyObj As Object, MySource As Object, file As Variant
   file = Dir("c:\testfolder\")
   While (file <> "")
      If InStr(file, "test") > 0 Then
         MsgBox "found " & file
         Exit Sub
      End If
     file = Dir
  Wend
End Sub
grantnz
quelle
3
Großartig, vielen Dank. Ich benutze Dir, aber ich wusste nicht, dass du es auch so benutzen kannst. Außerdem ist mit dem Befehl FileDateTimemein Problem gelöst.
Tyrex
4
Noch eine Frage. Ich könnte die Geschwindigkeit erheblich verbessern, wenn DIR mit den neuesten Dateien beginnen würde. Sehen Sie einen Weg, dies zu tun?
Tyrex
3
Meine letztere Frage wurde durch den folgenden Kommentar von brettdj geklärt.
Tyrex
Dir wird notjedoch traverse the whole directory tree. Falls erforderlich: AnalystCave.com/vba-dir-function-how-to-traverse-directories/…
AnalystCave.com
Dir wird auch durch andere Dir-Befehle unterbrochen. Wenn Sie also eine Subroutine ausführen, die Dir enthält, kann sie in Ihrem ursprünglichen Sub "zurückgesetzt" werden. Durch die Verwendung von FSO gemäß der ursprünglichen Frage wird dieses Problem behoben. EDIT: habe gerade den Beitrag von @LimaNightHawk unten gesehen, dasselbe
Baldmosher
26

Die Dir-Funktion ist der richtige Weg, aber das Problem ist, dass Sie die DirFunktion nicht rekursiv verwenden können , wie hier angegeben , nach unten .

Die Art und Weise, wie ich damit umgegangen bin, besteht darin, die DirFunktion zu verwenden, um alle Unterordner für den Zielordner abzurufen, sie in ein Array zu laden und das Array dann an eine wiederkehrende Funktion zu übergeben.

Hier ist eine Klasse, die ich geschrieben habe, um dies zu erreichen. Sie beinhaltet die Möglichkeit, nach Filtern zu suchen. ( Sie müssen die ungarische Notation verzeihen, diese wurde geschrieben, als es der letzte Schrei war. )

Private m_asFilters() As String
Private m_asFiles As Variant
Private m_lNext As Long
Private m_lMax As Long

Public Function GetFileList(ByVal ParentDir As String, Optional ByVal sSearch As String, Optional ByVal Deep As Boolean = True) As Variant
    m_lNext = 0
    m_lMax = 0

    ReDim m_asFiles(0)
    If Len(sSearch) Then
        m_asFilters() = Split(sSearch, "|")
    Else
        ReDim m_asFilters(0)
    End If

    If Deep Then
        Call RecursiveAddFiles(ParentDir)
    Else
        Call AddFiles(ParentDir)
    End If

    If m_lNext Then
        ReDim Preserve m_asFiles(m_lNext - 1)
        GetFileList = m_asFiles
    End If

End Function

Private Sub RecursiveAddFiles(ByVal ParentDir As String)
    Dim asDirs() As String
    Dim l As Long
    On Error GoTo ErrRecursiveAddFiles
    'Add the files in 'this' directory!


    Call AddFiles(ParentDir)

    ReDim asDirs(-1 To -1)
    asDirs = GetDirList(ParentDir)
    For l = 0 To UBound(asDirs)
        Call RecursiveAddFiles(asDirs(l))
    Next l
    On Error GoTo 0
Exit Sub
ErrRecursiveAddFiles:
End Sub
Private Function GetDirList(ByVal ParentDir As String) As String()
    Dim sDir As String
    Dim asRet() As String
    Dim l As Long
    Dim lMax As Long

    If Right(ParentDir, 1) <> "\" Then
        ParentDir = ParentDir & "\"
    End If
    sDir = Dir(ParentDir, vbDirectory Or vbHidden Or vbSystem)
    Do While Len(sDir)
        If GetAttr(ParentDir & sDir) And vbDirectory Then
            If Not (sDir = "." Or sDir = "..") Then
                If l >= lMax Then
                    lMax = lMax + 10
                    ReDim Preserve asRet(lMax)
                End If
                asRet(l) = ParentDir & sDir
                l = l + 1
            End If
        End If
        sDir = Dir
    Loop
    If l Then
        ReDim Preserve asRet(l - 1)
        GetDirList = asRet()
    End If
End Function
Private Sub AddFiles(ByVal ParentDir As String)
    Dim sFile As String
    Dim l As Long

    If Right(ParentDir, 1) <> "\" Then
        ParentDir = ParentDir & "\"
    End If

    For l = 0 To UBound(m_asFilters)
        sFile = Dir(ParentDir & "\" & m_asFilters(l), vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
        Do While Len(sFile)
            If Not (sFile = "." Or sFile = "..") Then
                If m_lNext >= m_lMax Then
                    m_lMax = m_lMax + 100
                    ReDim Preserve m_asFiles(m_lMax)
                End If
                m_asFiles(m_lNext) = ParentDir & sFile
                m_lNext = m_lNext + 1
            End If
            sFile = Dir
        Loop
    Next l
End Sub
LimaNightHawk
quelle
Wenn ich Dateien in der Spalte auflisten möchte, was könnte eine Implementierung davon sein?
Jechaviz
@jechaviz Die GetFileList-Methode gibt ein Array von String zurück. Sie würden wahrscheinlich nur über das Array iterieren und die Elemente zu einer ListView oder ähnlichem hinzufügen. Details zum Anzeigen von Elementen in einer Listenansicht gehen wahrscheinlich über den Rahmen dieses Beitrags hinaus.
LimaNightHawk
6

Dir Die Funktion verliert leicht den Fokus, wenn ich Dateien aus anderen Ordnern verarbeite und verarbeite.

Ich habe mit der Komponente bessere Ergebnisse erzielt FileSystemObject.

Das vollständige Beispiel finden Sie hier:

http://www.xl-central.com/list-files-fso.html

Vergessen Sie nicht, im Visual Basic-Editor einen Verweis auf Microsoft Scripting Runtime festzulegen (über Extras> Verweise).

Versuche es!

felipe gaviria correa
quelle
Technisch gesehen ist dies die Methode, die der Fragesteller verwendet. Die Referenzen sind einfach nicht enthalten, was diese Methode verlangsamen würde.
Marcucciboy2
-2

Probier diese. ( LINK )

Private Sub CommandButton3_Click()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
    xWs.Copy
    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        Select Case xWb.FileFormat
            Case 51:
                FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If Application.ActiveWorkbook.HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56:
                FileExtStr = ".xls": FileFormatNum = 56
            Case Else:
                FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
    xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True

End Sub
Meelis Tara
quelle