web-dev-qa-db-fra.com

Boucle à travers les fichiers dans un dossier en utilisant VBA?

Je voudrais parcourir les fichiers d’un répertoire en utilisant vba dans Excel 2010.

Dans la boucle, il me faudra

  • le nom de fichier, et
  • la date à laquelle le fichier a été formaté.

J'ai codé ce qui suit, ce qui fonctionne bien si le dossier ne contient pas plus de 50 fichiers, sinon il est ridiculement lent (j'ai besoin de travailler avec des dossiers contenant plus de 10000 fichiers). Le seul problème de ce code est que l'opération de recherche de file.name prend énormément de temps.

Code qui fonctionne mais qui est waaaaaay trop lent (15 secondes par 100 fichiers): 


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

Problème résolu:

  1. Mon problème a été résolu par la solution ci-dessous, en utilisant Dird'une manière particulière (20 secondes pour 15 000 fichiers) et en vérifiant l'horodatage à l'aide de la commande FileDateTimename__.
  2. La prise en compte d'une autre réponse inférieure à 20 secondes est réduite à moins d'une seconde.
excelvbaexcel-2010
219
tyrex

Voici mon interprétation en tant que fonction à la place:

'#######################################################################
'# LoopThroughFiles
'# Function to Loop through files in current directory and return filenames
'# Usage: LoopThroughFiles ActiveWorkbook.Path, "txt" 'inputDirectoryToScanForFile
'# https://stackoverflow.com/questions/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
37
benmichae2.

Dir prend des caractères génériques, vous pouvez donc faire une grande différence en ajoutant le filtre pour test dès le départ et en évitant de tester chaque fichier.

Sub LoopThroughFiles()
    Dim StrFile As String
    StrFile = Dir("c:\testfolder\*test*")
    Do While Len(StrFile) > 0
        Debug.Print StrFile
        StrFile = Dir
    Loop
End Sub
234
brettdj

Dir semble être très rapide.

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
154
grantnz

La fonction Dir est la voie à suivre, mais le problème est que vous ne pouvez pas utiliser la fonction Dir, comme indiqué ici, vers le en bas .

Pour ce faire, j'ai utilisé la fonction Dir afin d'obtenir tous les sous-dossiers du dossier cible, de les charger dans un tableau, puis de passer le tableau à une fonction récursive.

Voici une classe que j'ai écrite qui accomplit cela, elle inclut la possibilité de rechercher des filtres. ( Vous devrez pardonner la notation hongroise, cela a été écrit quand c'était à la mode. )

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
24
LimaNightHawk

La fonction Dir perd le focus facilement lorsque je manipule et traite des fichiers provenant d'autres dossiers.

J'ai obtenu de meilleurs résultats avec le composant FileSystemObject.

Un exemple complet est donné ici:

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

N'oubliez pas de définir une référence dans Visual Basic Editor sur Microsoft Scripting Runtime (à l'aide de Outils> Références).

Essaie!

5
felipe gaviria correa