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

User · Answer

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  amp       amp  xWb Name  amp       amp  DateString MkDir FolderName For Each xWs In xWb Worksheets     xWs Copy     If Val Application Version   lt  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  amp       amp  Application ActiveWorkbook Sheets 1  Name  amp  FileExtStr     Application ActiveWorkbook SaveAs xFile  FileFormat  FileFormatNum     Application ActiveWorkbook Close False Next MsgBox  You can find the files in    amp  FolderName Application ScreenUpdating   True  End Sub

User · Answer

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  amp        amp  filenameCriteria      Do While Len StrFile   gt  0         Debug Print StrFile         StrFile   Dir      Loop  End Function

User · Answer

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   gt  0         Debug Print StrFile         StrFile   Dir     Loop End Sub

User · Answer

Dir seems to be very fast   Sub LoopThroughFiles       Dim MyObj As Object  MySource As Object  file As Variant    file   Dir  c  testfolder       While  file  lt  gt            If InStr file   test    gt  0 Then          MsgBox  found    amp  file          Exit Sub       End If      file   Dir   Wend End Sub

User · Answer

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   lt  gt      Then         ParentDir   ParentDir  amp          End If     sDir   Dir ParentDir  vbDirectory Or vbHidden Or vbSystem      Do While Len sDir          If GetAttr ParentDir  amp  sDir  And vbDirectory Then             If Not  sDir       Or sDir         Then                 If l  gt   lMax Then                     lMax   lMax   10                     ReDim Preserve asRet lMax                  End If                 asRet l    ParentDir  amp  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   lt  gt      Then         ParentDir   ParentDir  amp          End If      For l   0 To UBound m asFilters          sFile   Dir ParentDir  amp       amp  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  gt   m lMax Then                     m lMax   m lMax   100                     ReDim Preserve m asFiles m lMax                  End If                 m asFiles m lNext    ParentDir  amp  sFile                 m lNext   m lNext   1             End If             sFile   Dir         Loop     Next l End Sub

User · Answer

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

[excel] Loop through files in a folder using VBA?

Examples related to excel

Examples related to vba