File Identification

[ScotTFO]

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?

 

[xenou]

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.

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

 

[ScotTFO]

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]

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.

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

 

[xenou]

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

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