Loop through files in a folder using VBA?

Question

I would like to loop through the files of a directory using vba in Excel 2010.

In the loop, I will need:

the filename, and
the date at which the file was formatted.

I have coded the following which works fine if the folder has no more then 50 files, otherwise it is ridiculously slow (I need it to work with folders with >10000 files). The sole problem of this code is that the operation to look up file.name takes extremely much time.

Code that works but is waaaaaay too slow (15 seconds per 100 files):

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 solved:

My problem has been solved by the solution below using Dir in a particular way (20 seconds for 15000 files) and for checking the time stamp using the command FileDateTime.
Taking into account another answer from below the 20 seconds are reduced to less than 1 second.

Your initial time seems slow for VBA still. Are you using Application.ScreenUpdating=false? — Michiel van der Blonk, Nov 23 '15 at 01:14
You seem to be missing `code` Set MyObj = New FileSystemObject — baldmosher, Jan 25 '17 at 12:55
I find it rather sad that people are quick to call FSO "slow", but no one mentions the performance penalty you could avoid by simply using early binding instead of late-bound calls against `Object`. — Mathieu Guindon, Aug 09 '17 at 14:17

score 297 · Answer 1 · answered Apr 30 '12 at 11:23

297

Dir takes wild cards so you could make a big difference adding the filter for test up front and avoiding testing each file

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

answered Apr 30 '12 at 11:23

brettdj

54,857
16
114
177

33

GREAT. This just improved the runtime from 20 seconds to <1 seconds. That's a big improvement, since the code will be run pretty often. THANK YOU!! – tyrex Apr 30 '12 at 12:48
It could be because the Do while...loop is better then while... wend. more info here http://stackoverflow.com/questions/32728334/do-while-loop-and-while-wend-loop-whats-the-difference – Hila DG May 26 '16 at 01:27
7

I don't think by that improvement level (20 - xxx times) - I think its the wildcard making a difference. – brettdj May 26 '16 at 02:36
1

DIR() does not seem to return Hidden files. – hamish Nov 20 '18 at 14:26
2

@hamish, you can change its argument to return different type of files (hidden, system, etc.) - see MS documentation : https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/dir-function – Vincent Apr 14 '20 at 12:47
2

I don't understand the line `StrFile = Dir`. This doesn't work for me. I used `Output = StrFile` instead. – Kar.ma Jun 22 '20 at 16:48
1

For those coming across the comment of Kar.ma and are wondering the same thing, `StrFile = Dir` in the While loop is simply setting StrFile to the next found file in the previously set up `Dir("c:\testfolder\*test*"`. As an example: if there was a test1.xlsx and a test2.xlsx, the `Debug.Print StrFile` would first give the test1 and then `StrFile = Dir` would find the next match which is the test2 (and so stay in the while loop). Hope that clears things up a bit. – Notus_Panda Mar 03 '23 at 12:53

score 168 · Answer 2 · edited Apr 30 '12 at 11:23

168

Dir seems to be very fast.

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

edited Apr 30 '12 at 11:23

brettdj

54,857
16
114
177

answered Apr 30 '12 at 08:08

grantnz

7,322
1
31
38

4

Great, thank you very much. I do use Dir but I didn't know that you can use it that way also. In addition with the command `FileDateTime` my problem is solved. – tyrex Apr 30 '12 at 08:24
5

Still one question. I could severely improve the speed if DIR would loop starting with the most recent files. Do you see any way to do this? – tyrex Apr 30 '12 at 09:04
4

My latter question has been settled by the comment below from brettdj. – tyrex Apr 30 '12 at 12:51
Dir will `not` however `traverse the whole directory tree`. In case needed: http://analystcave.com/vba-dir-function-how-to-traverse-directories/#Traversing_directories – AnalystCave.com Jan 25 '16 at 11:03
Dir will also be interrupted by other Dir commands, so if you run a subroutine containing Dir, it can "reset" it in your original sub. Using FSO as per original question eliminates this issue. EDIT: just seen the post by @LimaNightHawk below, same thing – baldmosher Jan 25 '17 at 12:45
So `dir(path)` takes the first file of `path` and then you have to call dir without arg again to get the rest of the path as stated [here](https://support.microsoft.com/en-us/office/dir-function-1a1a4275-f92f-4ae4-8b87-41e4513bba2e?ocmsassetid=ha001228824&correlationid=93c68ac7-3a86-49d1-a45b-867a7a4ea782&ui=en-us&rs=en-us&ad=us): `Dir returns the first file name that matches pathname. To get any additional file names..`. See [this](https://stackoverflow.com/a/24018460/1705829) answer here. – Timo Aug 26 '21 at 15:51

score 62 · Accepted Answer · answered Aug 18 '17 at 06:09

Here's my interpretation as a Function Instead:

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

why function, when nothing is returned back ? isn't this same as the answer given by brettdj, except it is enclosed in a function — Shafeek, Jul 24 '18 at 14:05

LimaNightHawk · Answer 4 · 2014-08-19T12:49:47.183

The Dir function is the way to go, but the problem is that you cannot use the Dir function recursively, as stated here, towards the bottom.

The way that I've handled this is to use the Dir function to get all of the sub-folders for the target folder and load them into an array, then pass the array into a function that recurses.

Here's a class that I wrote that accomplishes this, it includes the ability to search for filters. (You'll have to forgive the Hungarian Notation, this was written when it was all the rage.)

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

If i would like to list files found in column, what could be an implementation of this? — jechaviz, Jul 26 '14 at 04:31
@jechaviz The GetFileList method returns an array of String. You would probably just iterate over the array and add the items to a ListView, or something like that. Details on how to show items in a listview are probably beyond the scope of this post. — LimaNightHawk, Jul 28 '14 at 11:53
Many Thanks, just to suggest that at the end of `GetFileList` Function, an Else could be added: `If m_lNext Then` ...`Else` ... `ReDim GetFileList(0) As String`. As suggested here: [https://stackoverflow.com/a/35221544/6406135] — robertocm, Sep 28 '22 at 07:00

score 6 · Answer 5 · answered Aug 28 '17 at 16:49

6

Dir function loses focus easily when I handle and process files from other folders.

I've gotten better results with the component FileSystemObject.

Full example is given here:

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

Don't forget to set a reference in the Visual Basic Editor to Microsoft Scripting Runtime (by using Tools > References)

Give it a try!

answered Aug 28 '17 at 16:49

felipe gaviria correa

101
2
8

Technically this is the method that the asker is using, they just don't have their references included which would be slowing this method down. – Marcucciboy2 Jul 18 '18 at 12:52

score 0 · Answer 6 · edited Jul 29 '23 at 06:16

Here is one that returns a collection that you can then iterate through - you could use a dictionary if you wanted more than just file name

Sub test()
    Dim c As Collection
    Set c = LoopThroughFiles(ThisWorkbook.Path, ".xlsx")
    For Each f In c
        Debug.Print f
    Next
End Sub

Function LoopThroughFiles(inputDirectoryToScanForFile, filenameCriteria) As Collection
    Dim col As New Collection
    Dim StrFile As String
    'Debug.Print "in LoopThroughFiles. inputDirectoryToScanForFile: ", inputDirectoryToScanForFile
    StrFile = Dir(inputDirectoryToScanForFile & "\*" & filenameCriteria)
    Do While Len(StrFile) > 0
        '//Debug.Print StrFile
        col.Add StrFile
        StrFile = Dir
    Loop
    Set LoopThroughFiles = col
End Function

Assuming a user of this code would be using `Option Explicit` then you need to declare `f` ie `Dim f As Variant` otherwise the code will not run — JohnM, Jul 29 '23 at 16:29

score -2 · Answer 7 · edited Mar 10 '18 at 03:13

Try this one. (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

Loop through files in a folder using VBA?

7 Answers7

Linked

Related