File Identification

ScotTFO

Board Regular
Joined
May 30, 2008
Messages
72
I am trying to write a vba macro that will look in folders and their subfolders to find files with specified filetypes, and also count how many, as well as count how many files are over xx kilobytes large.

Should both these process be done at once or should I split them up?

Also what is the best method of searching down deep of sub-directories?
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

xenou

MrExcel MVP
Joined
Mar 2, 2007
Messages
16,795
Office Version
  1. 2019
Platform
  1. Windows
I like the file system object and this is a good job for it! The following code uses a recursive call to "go down" into the subfolders and get file information when it hits the bottom.

You'll find that you can starting working with the file attributes pretty easily at that point:
IF Right(oFile.Name,3) = "xls" Then Debug.Print "Excel file found..."
IF oFile.Size > 204800 Then Debug.Print "File greater than 200Kb"
Etc.

Code:
Option Explicit
Dim oFileSystem As FileSystemObject

Sub LoopFolders()
    'To use this procedure you must set a reference for Scripting Runtime
    '--------------------------------------------------
    '1.  In the VBE window, Choose Tools | References
    '2.   Check the box for Microsoft Scripting Runtime
    '--------------------------------------------------

    Dim oFolder As Folder
    
    Set oFileSystem = New FileSystemObject
    Set oFolder = oFileSystem.GetFolder("C:\TEMP")
    
    Call DownTheRabbitHole(oFolder)

End Sub
'-----------------------------------------
Private Sub DownTheRabbitHole(f As Folder)

    Dim oFolder As Folder
    Dim oFile As File
    
    'Recursive code
    For Each oFolder In f.SubFolders
        Call DownTheRabbitHole(oFolder)
    Next oFolder
    
    'Output file information when last folder is reached
    For Each oFile In f.Files
    Debug.Print "Folder:" & f.Name & "|" & "File:" & oFile.Name & "|" & "Size:" & oFile.Size & " Kb"
    Next oFile

End Sub

AB
 
Last edited:

ScotTFO

Board Regular
Joined
May 30, 2008
Messages
72
This is almost perfect to what I need, though how could I pass my findings to the original process running then?

Say I wanted to count how many files had the "xls" extension and how many files were above "xx" kb and wanted to put those values in a cell during a different process.
 

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,112
Office Version
  1. 365
Platform
  1. Windows
You can make this a bit more efficient by putting it all in one Sub. It deletes all of Column A prior to inserting the found xls filenames that are > 25 kb.
Code:
Option Base 0
Sub BigFiles()
  Dim f() As Variant, e As Variant, bigf() As Variant, i As Long
 
  f() = FindFiles(ThisWorkbook.Path, "*.xls")
  i = -1
  For Each e In f()
        'Get files larger than 25 kb
        If FileLen(e) / 1000 > 25 Then
          i = i + 1
          ReDim Preserve bigf(i)
          bigf(i) = e
        End If
  Next e
 
  If bigf(0) = "" Then Exit Sub
  Range("A:A").ClearContents
  Range("A1").Resize(UBound(bigf) + 1) = bigf()
End Sub
Function FindFiles(sRootFolder As String, sFiles As String, _
  Optional searchSubFolders As Boolean = True) As Variant
 
    Dim fs As Object
    Dim strFilename As String
    Dim i As Long, LastRow As Long
    Dim a() As Variant
 
    Set fs = Application.FileSearch
    With fs
        .LookIn = sRootFolder
        .Filename = sFiles 'set your filename or extension with wilcards if needed.
        .searchSubFolders = searchSubFolders
        LastRow = .FoundFiles.Count
        If .Execute() > 0 Then
            For i = 1 To LastRow
                strFilename = .FoundFiles(i)
                ReDim Preserve a(i - 1)
                a(i - 1) = strFilename
            Next i
        Else
            MsgBox "No files found", vbCritical
        End If
    End With
 
    FindFiles = a()
 
End Function
 
Last edited:

xenou

MrExcel MVP
Joined
Mar 2, 2007
Messages
16,795
Office Version
  1. 2019
Platform
  1. Windows
I see we have a filesearch solution too. Awesome. Looks good. In case your interested, one answer to your question using my routine would be to use some arrays to hold the data, then write the arrays to a worksheet - or whatever else - you'd probably want to tailor the information as needed (I put the new variable at the module level for easy access from either routine).

Code:
Option Explicit
Dim oFileSystem As FileSystemObject
Dim a() As Variant
Dim b() As Variant
Dim lngCountA As Long
Dim lngCountB As Long

Sub LoopFolders()
    'To use this fn you must set a reference for Scripting Runtime
    '--------------------------------------------------
    '1.  In the VBE window, Choose Tools | References
    '2.   Check the box for Microsoft Scripting Runtime
    '--------------------------------------------------

    Dim oFolder As Folder
    Dim ws As Worksheet
    
    Set oFileSystem = New FileSystemObject
    Set oFolder = oFileSystem.GetFolder("C:\TEMP")
    
    Call DownTheRabbitHole(oFolder)
    
    'Write results to Excel sheet
    Set ws = Workbooks.Add.Worksheets(1)
    On Error Resume Next 'In case arrays are empty
    ws.Cells(1, 1).Resize(UBound(a), 1).Value = WorksheetFunction.Transpose(a)
    ws.Cells(1, 1).EntireColumn.AutoFit
    ws.Cells(1, 6).Resize(UBound(b), 1).Value = WorksheetFunction.Transpose(b)
    ws.Cells(1, 6).EntireColumn.AutoFit
    On Error GoTo 0
    
    'Cleanup Module-level variables
    Set oFileSystem = Nothing
    Erase a
    Erase b
    lngCountA = Empty
    lngCountB = Empty

End Sub
'-----------------------------------------
Private Sub DownTheRabbitHole(f As Folder)

    Dim oFolder As Folder
    Dim oFile As File
    
    'Recursive code
    For Each oFolder In f.SubFolders
        Call DownTheRabbitHole(oFolder)
    Next oFolder
    
    'Output file information to arrays when last folder is reached
    For Each oFile In f.Files
        If Right(oFile.Name, 3) = "xls" Then 'Only xls files (XL 97-2003)
            lngCountA = lngCountA + 1
            ReDim Preserve a(1 To lngCountA)
            a(lngCountA) = "Folder:" & f.Name & "|" & "File:" & oFile.Name & "|" & "Size:" & oFile.Size & " Kb"
        End If
        If oFile.Size > 200 Then
            lngCountB = lngCountB + 1
            ReDim Preserve b(1 To lngCountB)
            b(lngCountB) = "Folder:" & f.Name & "|" & "File:" & oFile.Name & "|" & "Size:" & oFile.Size
        End If
    Next oFile

End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,123,140
Messages
5,599,964
Members
414,352
Latest member
macquarie_jchan58

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top