¿Recorrer archivos en una carpeta usando VBA?

Me gustaría recorrer los archivos de un directorio usandovbaen Excel 2010.

En el bucle, necesitaré:

• el nombre del archivo, y
• la fecha en la que se formateó el archivo.

He codificado lo siguiente que funciona bien si la carpeta no tiene más de 50 archivos; de lo contrario, es ridículamente lento (necesito que funcione con carpetas con >10000 archivos). El único problema de este código es que la operación de búsqueda file.namelleva muchísimo tiempo.

Código que funciona pero es muuuucho lento (15 segundos por 100 archivos):

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

Problema resuelto:

1. Mi problema se resolvió con la siguiente solución usando Dirde una manera particular (20 segundos para 15000 archivos) y verificando la marca de tiempo usando el comando FileDateTime.
2. Teniendo en cuenta otra respuesta inferior los 20 segundos se reducen a menos de 1 segundo.

Apr 30 '12 15:04 tyrex

Dir parece ser muy rápido.

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

Apr 30 '2012 08:04 grantnz

Aquí está mi interpretación como función:

'#######################################################################
'# 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

Aug 18 '2017 06:08 benmichae2.

La función Dir es el camino a seguir, pero el problema es que no puedes usar la Dirfunción de forma recursiva , como se indica aquí, hacia la parte inferior .

La forma en que he manejado esto es usar la Dirfunción para obtener todas las subcarpetas de la carpeta de destino y cargarlas en una matriz, luego pasar la matriz a una función recurrente.

Aquí hay una clase que escribí que logra esto; incluye la capacidad de buscar filtros. ( Tendrás que perdonar la notación húngara, esto fue escrito cuando estaba de moda ) .

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

Jun 03 '2014 14:06 LimaNightHawk

DirLa función pierde el foco fácilmente cuando manejo y proceso archivos de otras carpetas.

Obtuve mejores resultados con el componente FileSystemObject.

El ejemplo completo se proporciona aquí:

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

No olvide establecer una referencia en el Editor de Visual Basic a Microsoft Scripting Runtime (usando Herramientas > Referencias)

¡Darle una oportunidad!

Aug 28 '2017 16:08 felipe gaviria correa