275

I would like to loop through the files of a directory using 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:

  1. 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.
  2. Taking into account another answer from below the 20 seconds are reduced to less than 1 second.
Improve this question
3
  • Your initial time seems slow for VBA still. Are you using Application.ScreenUpdating=false? Commented Nov 23, 2015 at 1:14
  • 3
    You seem to be missing code Set MyObj = New FileSystemObject Commented Jan 25, 2017 at 12:55
  • 19
    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. Commented Aug 9, 2017 at 14:17

7 Answers 7

Reset to default
308

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
Improve this answer
Sign up to request clarification or add additional context in comments.

7 Comments

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!!
I don't think by that improvement level (20 - xxx times) - I think its the wildcard making a difference.
@hamish, you can change its argument to return different type of files (hidden, system, etc.) - see MS documentation : learn.microsoft.com/en-us/office/vba/language/reference/…
I don't understand the line StrFile = Dir. This doesn't work for me. I used Output = StrFile instead.
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.
|
169

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
Improve this answer

6 Comments

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.
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?
My latter question has been settled by the comment below from brettdj.
Dir will not however traverse the whole directory tree. In case needed: analystcave.com/vba-dir-function-how-to-traverse-directories/…
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
|
62

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
Improve this answer

1 Comment

why function, when nothing is returned back ? isn't this same as the answer given by brettdj, except it is enclosed in a function
30

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
Improve this answer

3 Comments

If i would like to list files found in column, what could be an implementation of this?
@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.
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: [stackoverflow.com/a/35221544/6406135]
7

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!

Improve this answer

1 Comment

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.
1

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
Improve this answer

1 Comment

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
-2

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
Improve this answer

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.