Search for file in a specified location and display needed info 1

[jaabaar]

Writing a function that search any drive specified. In that drive specified it must search all directories and their subsequent subdirectories for a specified excel file and display file name parent drive and location found. For example

1. Search each folder for an excel file
2. If excel file not found in folder and subfolder say so then move to next folder untill all folders are searched
3. If excel found display folder name, location

I have tried to do it but as you can see it does not work and when I managed to do it it never checks for none existence for search sun directories and only does it one.

Public Function SearchForFile()

On Error GoTo SearchForFile_Fail
Dim strDriveLoc As String
Dim strSearchFor As String
Dim strPath As String


Dim strPathMatch As String

strDriveLoc = "G:\" ' Must not say exact location of folder
strSearchFor = "test1.xlsx"
strPath = strDriveLoc & "\" & strSearchFor

strPath = strDriveLoc & "\" & strSearchFor
sFile = Dir(strPath, vbDirectory)

Do While Len(sFile) > 0
'If Left(sFile, 1) <> "." Then
If strDriveLoc <> "." And strDriveLoc <> ".." Then
If (GetAttr(strDriveLoc) And vbDirectory) = vbDirectory Then
strPathMatch = sFile
Debug.Print sFile 'display file name
Debug.Print Dir(strPath, vbDirectory) 'display parent directory
Debug.Print strPath 'display path

'Exit Do
End If
Else
Debug.Print "file not fount in that directory:" & Dir(strPath, vbDirectory)
End If
sFile = Dir
Loop

Exit_SearchForFile:
Exit Function

SearchForFile_Fail:
MsgBox "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
Resume Exit_SearchForFile
End Function


Again thank you in advance for all your help and will be much appreciated.

 

[jaabaar]

Hi
I have debugged the code and I am experiencing problems with duplicating/triplicating results and empty sufolders being displayed as empty as only the parent folder should be showing in results.

I would really appreciate if you could spare your valuable time to have a look at this issue.
Thank you.

Here a summary:
I have created in my file location (C:\ Documents) the below listed 6 folders as follows:

Folders no. 1+2 contain spreadsheets - no subfolders.
Folders no. 3+4 contain spreadsheets - with subfolders.
Folder no 5 contains no spreadsheets – no subfolders.
Folder no 6 contains no spreadsheets – with subfolders.

The program code should return folders names/location of 1 - 4 containing all the found spreadsheets. Folders no. 5+6 contain no spreadsheets but the result should still display the folder name as being empty (subfolders will not be shown when empty).

Folder 1
Folder 2
Folder 3
Folder 4
Folder 5
Folder 6

The program results below shows that it works however it double or triple counts the searches.

For example results as follows:
'###
Questions found in function “Public Function SearchForFile()”:
Debug.Print "Found colFiles.Count " & colFiles.Count & " files."
Debug.Print "Found colEmptyFolders.Count " & colEmptyFolders.Count & " folders."
Result for above question
Found colFiles.Count 18 files.
Found colEmptyFolders.Count 26 folders.
True Result should be
Found colFiles.Count 9 files.
Found colEmptyFolders.Count 6 folders.
‘##

Displaying detailed Result – It is duplicating results
'Display list of all files found - including the folder name/
For Each vFile In colFiles
Debug.Print "File Found: "; vFile
lnFileIsFound = True
Next vFile
File Found: C:\Documents\Folder 1\Spreadsheet 1.xlsx
File Found: C:\Documents\Folder 1\Spreadsheet 2.xlsx
File Found: C:\Documents\Folder 2\Spreadsheet 3.xlsx
File Found: C:\ Documents\Folder 3\Spreadsheet 4.xlsx
File Found: C:\Documents\Folder 3\SubFolder 1\Spreadsheet 6.xlsx
File Found: C:\Documents\Folder 3\SubFolder 2\Spreadsheet 5.xlsx
File Found: C:\Documents\Folder 4\Spreadsheet 7.xlsx
File Found: C:\Documents\Folder 4\SubFolder 1\Spreadsheet 8.xlsx
File Found: C:\Documents\Folder 4\SubFolder 2\Spreadsheet 9.xlsx
File Found: C:\Documents\Folder 1\Spreadsheet 1.xlsx
File Found: C:\Documents\Folder 1\Spreadsheet 2.xlsx
File Found: C:\Documents\Folder 2\Spreadsheet 3.xlsx
File Found: C:\Documents\Folder 3\Spreadsheet 4.xlsx
File Found: C:\Documents\Folder 3\SubFolder 1\Spreadsheet 6.xlsx
File Found: C:\Documents\Folder 3\SubFolder 2\Spreadsheet 5.xlsx
File Found: C:\Documents\Folder 4\Spreadsheet 7.xlsx
File Found: C:\Documents\Folder 4\SubFolder 1\Spreadsheet 8.xlsx
File Found: C:\Documents\Folder 4\SubFolder 2\Spreadsheet 9.xlsx

Empty Result – It is duplicating and showing subfolders as empty it should only show parent folder name and not empty subfolders

'Display list of all folders found that did NOT contain files being searched for.

For Each vFile In colEmptyFolders
Debug.Print "Empty Folder: "; vFile
blnFileIsFound = True
Next vFile

Empty Folder: C: \DocumentsEmpty Folder: C:\ DocumentsEmpty Folder: C:\Documents\Folder 6Empty Folder: C:\Documents\Folder 6Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 5Empty Folder: C:\Documents\Folder 5Empty Folder: C:\Documents\Folder 6Empty Folder: C:\Documents\Folder 6Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 1Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 6\SubFolder 2Empty Folder: C:\Documents\Folder 5Empty Folder: C:\Documents\Folder 5
The code functions are as follows:

Public Function SearchForFile()
Dim colFiles As New Collection
Dim vFile As Variant
Dim blnFileIsFound As Boolean
 
Set colFoundFiles = New Collection
Set colEmptyFolders = New Collection
 
blnFileIsFound = False
 
RecursiveDir colFiles, "C:\Documents", "*.xls", True
 
 
Debug.Print "Found colFiles.Count " & colFiles.Count & " files."
Debug.Print "Found colEmptyFolders.Count " & colEmptyFolders.Count & " folders."
 
'Display list of all files found - including the folder name/
 For Each vFile In colFiles
    Debug.Print "File Found: "; vFile
    lnFileIsFound = True
 Next vFile
 
'Display list of all folders found that did NOT contain files being searched for.
 For Each vFile In colEmptyFolders
    Debug.Print "Empty Folder: "; vFile
    blnFileIsFound = True
 Next vFile
 
If Not blnFileIsFound Then
    MsgBox "File Not Found.:" & vFile
End If

End Function

Public Function RecursiveDir (colFiles As Collection, _
                                strFolder As String, strFileSpec As String, bIncludeSubfolders As Boolean)

On Error GoTo RecursiveDir_Fail

 Dim strTemp As String
 Dim colFolders As New Collection
 Dim vFolderName As Variant
 Dim blnFound As Boolean
 Dim lItems As Long

'set initial start to false
blnFound = False
Set colFolders = New Collection
 
 ' Make sure that the folder names we are processing end with the slash character.
 'if it does do nothing. if it does not add

 If Right(strFolder, 1) = "\" Or Right(strFolder, 1) = "/" Then
     'Ignore
 Else
    colFolders.Add strFolder & "\"
 End If

 'Add files in strFolder matching strFileSpec to colFiles, to build the collections
 strFolder = TrailingSlash(strFolder)
 strTemp = Dir(strFolder & strFileSpec)

 Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    colFoundFiles.Add strFolder & "|" & strTemp
     blnFound = True
    strTemp = Dir
 Loop
 
If blnFound = True Then
    For lItems = 1 To colFolders.Count
        If colFolders(lItems) = strFolder Then
            colFolders.Remove (lItems)
        End If
    Next lItems
 Else
    colEmptyFolders.Add strFolder
 End If

 If bIncludeSubfolders Then
 'Fill colFolders with list of subdirectories of strFolder
    strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
        If (strTemp <> ".") And (strTemp <> "..") Then
            If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                  colFolders.Add strFolder & strTemp
            End If
        End If
    strTemp = Dir
    Loop
 
' Calling RecursiveDir function to seach each subfolder in colFolders
' doing another search for blanks where excel file needed not found.
 For Each vFolderName In colFolders
    Debug.Print "Searching: " & vFolderName
    strFolder = vFolderName
    Call RecursiveDir(colFiles, strFolder, strFileSpec, True)
Next vFolderName
End If
 

Exit_RecursiveDir:
    
    Exit Function

RecursiveDir_Fail:

 Debug.Print Err.Number & vbTab & Err.Description
 If Err.Number = 52 Then ' Permissions denied on system folder...
    Resume Next
 ElseIf Err.Number = 53 Then ' File Not Found
    Resume Next
 Else
    MsgBox "Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & vbTab & Err.Description
    Resume Exit_RecursiveDir
 End If

End Function

 

[trevil620]

Well, I must disagree with you saying the count / location of the files found is wrong. I created a structure as you described (*mostly*), ran the code and it says it found 10 files and told me where they were. Next I opened Windows Explorer, went to the 'root' of the test and told it to find all '*.xls' files -- and it found 10 -- which I must contend is the correct number.

As for the list of 'empty' folders being incorrect because of duplicates, well, yes it reports duplicates. I made a change that should correct that.

I URGE you to copy ALL of the following code EXACTLY. The above code you sent back to me was incorrect because it had a compile error.
One issue you need to be aware of is that a high level folder can be marked as having no files, yet a subfolder within can contain files.

Wayne

Option Compare Database
Option Explicit

Dim colFoundFiles As Collection
Dim colEmptyFolders As Collection

Private Sub cmd_Search_Loc_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim blnFileIsFound As Boolean

Set colFoundFiles = New Collection
Set colEmptyFolders = New Collection

blnFileIsFound = False

RecursiveDir colFiles, "C:\temp\TestExcel\", "*.xls", True

' Below needs to handle blnFileIsFound = true and false at the same time. I Cant seem to fix and place inside the for condition.
Debug.Print ""
Debug.Print "Found colFiles.Count " & colFiles.Count & " files."
'Display list of all files found - including the folder name/
For Each vFile In colFiles
Debug.Print "File Found: "; vFile
blnFileIsFound = True
Next vFile

''Display list of all files found - including the folder name/
'Debug.Print ""
'Debug.Print "Found colFoundFiles.Count " & colFoundFiles.Count & " folders. (INCLUDES DELIMITER OF '|' IN CASE YOU WANT TO PARSE)"
'For Each vFile In colFoundFiles
' Debug.Print "File Found: "; vFile
' blnFileIsFound = True
'Next vFile

'Display list of all folders found that did NOT contain files being searched for.
Debug.Print ""
Debug.Print "Found colEmptyFolders.Count " & colEmptyFolders.Count & " folders."
For Each vFile In colEmptyFolders
Debug.Print "Empty Folder: "; vFile
blnFileIsFound = True
Next vFile

If Not blnFileIsFound Then
MsgBox "File Not Found.:" & vFile
End If

End Sub

Public Function RecursiveDir(colFiles As Collection, _
strFolder As String, _
strFileSpec As String, _
bIncludeSubfolders As Boolean)
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim blnFound As Boolean
Dim blfFoundEmpty As Boolean
Dim lItems As Long
Dim lEmpty As Long

On Error GoTo Error_Trap
blnFound = False
Set colFolders = New Collection
If Right(strFolder, 1) = "\" Or Right(strFolder, 1) = "/" Then
'Ignore
Else
colFolders.Add strFolder & "\"
End If

'Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)

Do While strTemp <> vbNullString
colFiles.Add strFolder & strTemp
colFoundFiles.Add strFolder & "|" & strTemp
blnFound = True
strTemp = Dir
Loop

If blnFound = True Then
For lItems = 1 To colFolders.Count
If colFolders(lItems) = strFolder Then
colFolders.Remove (lItems)
End If
Next lItems
Else
blfFoundEmpty = False
Debug.Print strFolder
For lEmpty = 1 To colEmptyFolders.Count
If colEmptyFolders(lEmpty) = strFolder Then
blfFoundEmpty = True
'Debug.Print "found"
End If
Next lEmpty
If blfFoundEmpty = False Then colEmptyFolders.Add strFolder
End If

If bIncludeSubfolders Then
'Fill colFolders with list of subdirectories of strFolder
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
'Debug.Print "Searching inside folder: " & strTemp
colFolders.Add strFolder & strTemp
End If
End If
strTemp = Dir
Loop

'Debug.Print "Found " & colFolders.Count & " folders."

'Call RecursiveDir function to seach each subfolder in colFolders
For Each vFolderName In colFolders
Debug.Print "Search: " & vFolderName
strFolder = vFolderName
Call RecursiveDir(colFiles, strFolder, strFileSpec, True)
Next vFolderName
End If

Exit Function
Error_Trap:
Debug.Print Err.Number & vbTab & Err.Description
If Err.Number = 52 Then ' Permissions denied on system folder...
Resume Next
ElseIf Err.Number = 53 Then ' File Not Found
Resume Next
Else
MsgBox "Maybe add code to handle error: " & Err.Number & vbTab & Err.Description
Resume Next
End If
End Function

 

[jaabaar]

Hi Wayne,

I believe you are getting correct numbers but as you can see my result bellow I am getting multiples of the correct number. I don’t understand why  and nothing is displayed for empty folders.

Found colFiles.Count 18 files. – That should be 9 as you can see below:
File Found: C:\Users\PUser\Documents\Folder 1\Spreadsheet 1.xlsx
File Found: C:\Users\PUser\Documents\Folder 1\Spreadsheet 2.xlsx
File Found: C:\Users\PUser\Documents\Folder 2\Spreadsheet 3.xlsx
File Found: C:\Users\PUser\Documents\Folder 3\Spreadsheet 4.xlsx
File Found: C:\Users\PUser\Documents\Folder 3\SubFolder 1\Spreadsheet 6.xlsx
File Found: C:\Users\PUser\Documents\Folder 3\SubFolder 2\Spreadsheet 5.xlsx
File Found: C:\Users\PUser\Documents\Folder 4\Spreadsheet 7.xlsx
File Found: C:\Users\PUser\Documents\Folder 4\SubFolder 1\Spreadsheet 8.xlsx
File Found: C:\Users\PUser\Documents\Folder 4\SubFolder 2\Spreadsheet 9.xlsx

You see below it is duplicating results I don’t understand why
File Found: C:\Users\PUser\Documents\Folder 1\Spreadsheet 1.xlsx
File Found: C:\Users\PUser\Documents\Folder 1\Spreadsheet 2.xlsx
File Found: C:\Users\PUser\Documents\Folder 2\Spreadsheet 3.xlsx
File Found: C:\Users\PUser\Documents\Folder 3\Spreadsheet 4.xlsx
File Found: C:\Users\PUser\Documents\Folder 3\SubFolder 1\Spreadsheet 6.xlsx
File Found: C:\Users\PUser\Documents\Folder 3\SubFolder 2\Spreadsheet 5.xlsx
File Found: C:\Users\PUser\Documents\Folder 4\Spreadsheet 7.xlsx
File Found: C:\Users\PUser\Documents\Folder 4\SubFolder 1\Spreadsheet 8.xlsx
File Found: C:\Users\PUser\Documents\Folder 4\SubFolder 2\Spreadsheet 9.xlsx

For empty it returns the following:
Found colEmptyFolders.Count 0 folders.

That should be 2 folders

Note: “One issue you need to be aware of is that a high level folder can be marked as having no files, yet a subfolder within can contain files.”
yes as per above results it can handle that (which is very important).

copied the code you gave me exactly as it is and I still get the duplication and 0 for empty folders.
Would you like me to email you my test database with a zipped directory with my files just to help explain the error I am getting? I do not seem to understand where I am going wrong.

Thank you again for all your help.

Private Sub cmd_Search_Loc_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim blnFileIsFound As Boolean
 
Set colFoundFiles = New Collection
Set colEmptyFolders = New Collection
 
blnFileIsFound = False
 
RecursiveDir colFiles, "C:\Users\PUser\Documents", "*.xls", True
 
Debug.Print ""
Debug.Print "Found colFiles.Count " & colFiles.Count & " files."
 
 'Display list of all files found - including the folder name/
 For Each vFile In colFiles
    Debug.Print "File Found: "; vFile
    blnFileIsFound = True
 Next vFile
 
''Display list of all files found - including the folder name/
 'Debug.Print ""
 'Debug.Print "Found colFoundFiles.Count " & colFoundFiles.Count & " folders. (INCLUDES DELIMITER OF '|' IN CASE YOU WANT TO PARSE)"
 'For Each vFile In colFoundFiles
 ' Debug.Print "File Found: "; vFile
 ' blnFileIsFound = True
 'Next vFile
 
'Display list of all folders found that did NOT contain files being searched for.

 Debug.Print "Found colEmptyFolders.Count " & colEmptyFolders.Count & " folders."
 For Each vFile In colEmptyFolders
    Debug.Print "Empty Folder: "; vFile
    blnFileIsFound = True
 Next vFile
 
If Not blnFileIsFound Then
 MsgBox "File Not Found.:" & vFile
End If
 
End Sub

Public Function RecursiveDir(colFiles As Collection, _
 strFolder As String, _
 strFileSpec As String, _
 bIncludeSubfolders As Boolean)
 Dim strTemp As String
 Dim colFolders As New Collection
 Dim vFolderName As Variant
 Dim blnFound As Boolean
 Dim blfFoundEmpty As Boolean
 Dim lItems As Long
 Dim lEmpty As Long
 
On Error GoTo Error_Trap
 blnFound = False
 Set colFolders = New Collection
 Set colEmptyFolders = New Collection
 Set colFoundFiles = New Collection
 
 
 If Right(strFolder, 1) = "\" Or Right(strFolder, 1) = "/" Then
 'Ignore
 Else
 colFolders.Add strFolder & "\"
 End If

 'Add files in strFolder matching strFileSpec to colFiles
 strFolder = TrailingSlash(strFolder)
 strTemp = Dir(strFolder & strFileSpec)

 Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    colFoundFiles.Add strFolder & "|" & strTemp
    blnFound = True
    strTemp = Dir
 Loop
 
If blnFound = True Then
    For lItems = 1 To colFolders.Count
        If colFolders(lItems) = strFolder Then
            colFolders.Remove (lItems)
        End If
    Next lItems
 Else
    blfFoundEmpty = False
    Debug.Print strFolder
    For lEmpty = 1 To colEmptyFolders.Count
    
        If colEmptyFolders(lEmpty) = strFolder Then
            blfFoundEmpty = True
        End If
    Next lEmpty
 End If
 
 If blfFoundEmpty = False Then
    colEmptyFolders.Add strFolder
 End If

 If bIncludeSubfolders Then
 'Fill colFolders with list of subdirectories of strFolder
    strTemp = Dir(strFolder, vbDirectory)
 Do While strTemp <> vbNullString
    If (strTemp <> ".") And (strTemp <> "..") Then
        If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
            colFolders.Add strFolder & strTemp
        End If
    End If
    strTemp = Dir
 Loop
 
'Debug.Print "Found " & colFolders.Count & " folders."

 'Call RecursiveDir function to seach each subfolder in colFolders
 For Each vFolderName In colFolders
    Debug.Print "Search: " & vFolderName
    strFolder = vFolderName
    Call RecursiveDir(colFiles, strFolder, strFileSpec, True)
 Next vFolderName
 
 End If
 
Exit Function
Error_Trap:
 Debug.Print Err.Number & vbTab & Err.Description
 If Err.Number = 52 Then ' Permissions denied on system folder...
 Resume Next
 ElseIf Err.Number = 53 Then ' File Not Found
 Resume Next
 Else
 MsgBox "Maybe add code to handle error: " & Err.Number & vbTab & Err.Description
 Resume Next
 End If
End Function

 

[trevil620]

I don't want to come across as rude, but you are not following the last set of directions I sent to you!

I used the code YOU SENT BACK TO ME -- and yes, it fails. If I use the code I sent you, then it works.

1. PLEASE COPY THE ENTIRE CODE I LAST SENT -- Starting with the "Option Compare Database" line that follows my name, and ending with the "End Function" at the bottom of that post.
2. Paste it into a BRAND NEW MODULE
3. Compile & check for errors (should be NONE)
4. Execute the first subroutine.

I keep finding differences between the code I am sending you and what you respond back with. We will NEVER be able to reconcile unless we BOTH use the SAME code.
Good Luck,
Wayne

 

[jaabaar]

Hi
Here are exact steps taken.
1. A brand new database created as access 2007 format
2. Created brand new form with a click button called “cmd_Search_Loc_Click” and placed its code
3. A new module was created called “module 1”
4. Placed “RecursiveDir” into “module 1”
5. In “Module 1“ I went menu “Debug” and clicked “Compile SearchDir”
6. I then went to form and clicked “cmd_Search_Loc_Click” I get an error for the following two lines also highlighted in the code:

colFoundFiles.Add strFolder & "|" & strTemp
For lEmpty = 1 To colEmptyFolders.Count

Compile error: Variable not defined

if I move global Declaration to "Module1"
Dim colFoundFiles As Collection
Dim colEmptyFolders As Collection
I get same error in form one.

7. "PLEASE COPY THE ENTIRE CODE I LAST SENT -- Starting with the "Option Compare Database" line that follows my name, and ending with the "End Function" at the bottom of that post."
Do you mean copy everything in form1 or all in module1. I have placed the codes unchanged to my understanding in form1 and module1 for the search

Code placed in form1 as follow:

Option Compare Database
Option Explicit
Dim colFoundFiles As Collection
Dim colEmptyFolders As Collection

Private Sub cmd_Search_Loc_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim blnFileIsFound As Boolean
 
Set colFoundFiles = New Collection
Set colEmptyFolders = New Collection
 
blnFileIsFound = False
 
RecursiveDir colFiles, "C:\Users\PUser\Documents\", "*.xls", True
 
' Below needs to handle blnFileIsFound = true and false at the same time. I Cant seem to fix and place inside the for condition.
 
 Debug.Print ""
 Debug.Print "Found colFiles.Count " & colFiles.Count & " files."
 'Display list of all files found - including the folder name/
 For Each vFile In colFiles
    Debug.Print "File Found: "; vFile
    blnFileIsFound = True
 Next vFile
 
''Display list of all files found - including the folder name/
 'Debug.Print ""
 'Debug.Print "Found colFoundFiles.Count " & colFoundFiles.Count & " folders. (INCLUDES DELIMITER OF '|' IN CASE YOU WANT TO PARSE)"
 'For Each vFile In colFoundFiles
 ' Debug.Print "File Found: "; vFile
 ' blnFileIsFound = True
 'Next vFile
 
'Display list of all folders found that did NOT contain files being searched for.
 Debug.Print ""
 Debug.Print "Found colEmptyFolders.Count " & colEmptyFolders.Count & " folders."
 For Each vFile In colEmptyFolders
    Debug.Print "Empty Folder: "; vFile
    blnFileIsFound = True
 Next vFile
 
If Not blnFileIsFound Then
    MsgBox "File Not Found.:" & vFile
End If
 
End Sub

Code placed in module1 as follow:

Option Compare Database
Option Explicit


Public Function RecursiveDir(colFiles As Collection, _
 strFolder As String, _
 strFileSpec As String, _
 bIncludeSubfolders As Boolean)
 
 Dim strTemp As String
 Dim colFolders As New Collection
 Dim vFolderName As Variant
 Dim blnFound As Boolean
 Dim blfFoundEmpty As Boolean
 Dim lItems As Long
 Dim lEmpty As Long

 On Error GoTo Error_Trap
 
 blnFound = False
 
 Set colFolders = New Collection
 
 If Right(strFolder, 1) = "\" Or Right(strFolder, 1) = "/" Then
    'Ignore
 Else
    colFolders.Add strFolder & "\"
 End If

 'Add files in strFolder matching strFileSpec to colFiles
 strFolder = TrailingSlash(strFolder)
 strTemp = Dir(strFolder & strFileSpec)

 Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    [b]colFoundFiles.Add strFolder & "|" & strTemp[/b]
    blnFound = True
    strTemp = Dir
 Loop
 
If blnFound = True Then
    For lItems = 1 To colFolders.Count
        If colFolders(lItems) = strFolder Then
            colFolders.Remove (lItems)
        End If
    Next lItems
 Else
    blfFoundEmpty = False
    Debug.Print strFolder
   [b] For lEmpty = 1 To colEmptyFolders.Count[/b]
        If colEmptyFolders(lEmpty) = strFolder Then
            blfFoundEmpty = True
            'Debug.Print "found"
        End If
    Next lEmpty
    If blfFoundEmpty = False Then colEmptyFolders.Add strFolder
 End If

 If bIncludeSubfolders Then
    'Fill colFolders with list of subdirectories of strFolder
    strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
        If (strTemp <> ".") And (strTemp <> "..") Then
            If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                'Debug.Print "Searching inside folder: " & strTemp
                colFolders.Add strFolder & strTemp
            End If
        End If
        strTemp = Dir
    Loop
 
'Debug.Print "Found " & colFolders.Count & " folders."

 'Call RecursiveDir function to seach each subfolder in colFolders
 For Each vFolderName In colFolders
    Debug.Print "Search: " & vFolderName
    strFolder = vFolderName
    Call RecursiveDir(colFiles, strFolder, strFileSpec, True)
 Next vFolderName
 End If
 
Exit Function
Error_Trap:
 Debug.Print Err.Number & vbTab & Err.Description
 If Err.Number = 52 Then ' Permissions denied on system folder...
 Resume Next
 ElseIf Err.Number = 53 Then ' File Not Found
 Resume Next
 Else
 MsgBox "Maybe add code to handle error: " & Err.Number & vbTab & Err.Description
 Resume Next
 End If
 End Function
 
Public Function TrailingSlash(varIn As Variant) As String
'ensures that the folder names we are processing end with the slash character

    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

 

[strongm]

Here's a slight alternative, using the filesystemobject. You'll need to add a reference to the Microsoft Scripting Object. Then put this code into a module:

[blue]Option Compare Database
Option Explicit

Private colFoundFiles As Collection
Private colEmptyFolders As Collection

Public Sub MainExample()
    Dim result As Boolean
    Dim vFile As Variant
    Set colFoundFiles = New Collection
    Set colEmptyFolders = New Collection
    
    [green]' use your own path and file pattern here[/green]
    If FindFile("c:\test", "*.txt") Then
        For Each vFile In colFoundFiles
            Debug.Print "File Found: "; vFile
        Next vFile
        
        For Each vFile In colEmptyFolders
            Debug.Print "Empty Folder: "; vFile
        Next vFile
    Else
        MsgBox "No file(s) found"
    End If
End Sub

[green]' PathDepth controls how deep we recurse into the folder hierarchy[/green]
Private Function FindFile(strRoot As String, Optional strFile As String = "*.*", Optional PathDepth As Long = 255)
    Dim fso As New FileSystemObject
    Debug.Print "Searching for " & strFile & " in " & strRoot
    RecurseFolder fso.GetFolder(strRoot), strFile, PathDepth
    FindFile = colFoundFiles.Count > 0
End Function

Private Function RecurseFolder(oFolder As Folder, strFile As String, MaxDepth As Long) As Boolean
    Dim checkfile As File
    Dim checkfolder As Folder
    Dim result As Boolean
    Static Depth As Long
    
    For Each checkfile In oFolder.Files
        If checkfile.Name Like strFile Then
            RecurseFolder = True
            colFoundFiles.Add checkfile.Path
        End If
    Next

    Depth = Depth + 1
    If Depth <= MaxDepth Then [green]'Only bother if we have not recursed into folder hieracrchy deeper than we wanted[/green]
        For Each checkfolder In oFolder.SubFolders
            RecurseFolder = RecurseFolder(checkfolder, strFile, MaxDepth)
            If Not RecurseFolder Then
                If Depth = 1 Then
                    colEmptyFolders.Add checkfolder.Path
                End If
            End If
        Next
    End If
    Depth = Depth - 1

End Function[/blue]

And then the following code for your command button:

[blue]Private Sub cmd_Search_Loc_Click()
    MainExample
End Sub[/blue]

 

[trevil620]

Thanks Strongm for your help.

jaabaar, I meant for you to:
1. Open Access
2. Create a NEW MODULE (not a form)
3. Paste Entire contents as I provided
4. I forgot to mention to change the path I used to your 'documents' path
5. Compile code (note, you have previously been leaving out the two collection Dim's, that are outside (above) the first code).
6. Place cursor anywhere inside first subroutine
7. Press F5 and it should work.

Leaving town, but will check tonight...
Good luck,
Wayne

 

[jaabaar]

Hi Wayne,

Thanks Strongm for your help.

First of all thank you very much for taking the time to help me with this although you are very busy.

Here a summary:

I have created in my file location (C:\TestExcel\) the below listed 6 folders as follows:

Folders no. 1+2 parent contains spreadsheets - no subfolders.
Folders no. 3 parent contains no spreadsheets – subfolders contain spreadsheets.
Folders no. 4 parent contains spreadsheets - subfolders contain spreadsheets.
Folder no 5 parent contains no spreadsheets – no subfolders.
Folder no 6 parent contains no spreadsheets – with subfolders containing no spreadsheets.

Actions taken to run program:
1. Placed entire contents into “Module”
2. Compiled code no errors produced. 
3. Pressed F5 to run the code:

Result as follow
Files found
Found colFiles.Count 12 files.
True result should have been 9. As bold files in folder 3 have been duplicated.

File Found: C:\TestExcel\Folder 1\Spreadsheet 1.xlsx
File Found: C:\TestExcel\Folder 1\Spreadsheet 2.xlsx
File Found: C:\TestExcel\Folder 2\Spreadsheet 3.xlsx
File Found: C:\TestExcel\Folder 3\SubFolder 1\Spreadsheet 6.xlsx
File Found: C:\TestExcel\Folder 3\SubFolder 2\Spreadsheet 5.xlsx
File Found: C:\TestExcel\Folder 3\SubFolder 2\Spreadsheet 4.xlsx
File Found: C:\TestExcel\Folder 3\SubFolder 1\Spreadsheet 6.xlsx
File Found: C:\TestExcel\Folder 3\SubFolder 2\Spreadsheet 5.xlsx
File Found: C:\TestExcel\Folder 3\SubFolder 2\Spreadsheet 4.xlsx
File Found: C:\TestExcel\Folder 4\Spreadsheet 7.xlsx
File Found: C:\TestExcel\Folder 4\SubFolder 1\Spreadsheet 8.xlsx
File Found: C:\TestExcel\Folder 4\SubFolder 2\Spreadsheet 9.xlsx

Results for Empty Folder

Found colEmptyFolders.Count 6 folders.
True result I want it be 3. As bold files in Empty Folder result. I dont want them to show.

Empty Folder: C:\TestExcel\ = is empty

Folder 6 parent = including its sub folders contain no spreadsheets. I want it to only show parent name. Empty Subfolders should not show up.

Folder 3 = should not show up under empty folder as its SUBfolder contains spreadsheets.

Empty Folder: C:\TestExcel Empty Folder: C:\TestExcel\Folder 6Empty Folder: C:\TestExcel\Folder 6\SubFolder 1\
Empty Folder: C:\TestExcel\Folder 6\SubFolder 2\
Empty Folder: C:\TestExcel\Folder 3\
Empty Folder: C:\TestExcel\Folder 5
Code in module as follow:

Option Compare Database
Option Explicit
 
Dim colFoundFiles As Collection
Dim colEmptyFolders As Collection

Private Sub cmd_Search_Loc_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim blnFileIsFound As Boolean
 
Set colFoundFiles = New Collection
Set colEmptyFolders = New Collection
 
blnFileIsFound = False
 
RecursiveDir colFiles, "C:\TestExcel\", "*.xls", True
 
' Below needs to handle blnFileIsFound = true and false at the same time. I Cant seem to fix and place inside the for condition.
 Debug.Print ""
 Debug.Print "Found colFiles.Count " & colFiles.Count & " files."
 'Display list of all files found - including the folder name/
 For Each vFile In colFiles
    Debug.Print "File Found: "; vFile
    blnFileIsFound = True
 Next vFile
 
''Display list of all files found - including the folder name/
 'Debug.Print ""
 'Debug.Print "Found colFoundFiles.Count " & colFoundFiles.Count & " folders. (INCLUDES DELIMITER OF '|' IN CASE YOU WANT TO PARSE)"
 'For Each vFile In colFoundFiles
 ' Debug.Print "File Found: "; vFile
 ' blnFileIsFound = True
 'Next vFile
 
'Display list of all folders found that did NOT contain files being searched for.
 Debug.Print ""
 Debug.Print "Found colEmptyFolders.Count " & colEmptyFolders.Count & " folders."
 For Each vFile In colEmptyFolders
    Debug.Print "Empty Folder: "; vFile
    blnFileIsFound = True
 Next vFile
 
If Not blnFileIsFound Then
    MsgBox "File Not Found.:" & vFile
End If
 
End Sub 
 
Public Function RecursiveDir(colFiles As Collection, _
 strFolder As String, _
 strFileSpec As String, _
 bIncludeSubfolders As Boolean)
 Dim strTemp As String
 Dim colFolders As New Collection
 Dim vFolderName As Variant
 Dim blnFound As Boolean
 Dim blfFoundEmpty As Boolean
 Dim lItems As Long
 Dim lEmpty As Long

 On Error GoTo Error_Trap
 blnFound = False
 Set colFolders = New Collection
 If Right(strFolder, 1) = "\" Or Right(strFolder, 1) = "/" Then
    'Ignore
 Else
    colFolders.Add strFolder & "\"
 End If

 'Add files in strFolder matching strFileSpec to colFiles
 strFolder = TrailingSlash(strFolder)
 strTemp = Dir(strFolder & strFileSpec)

 Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    colFoundFiles.Add strFolder & "|" & strTemp
    blnFound = True
    strTemp = Dir
 Loop
 
If blnFound = True Then
 For lItems = 1 To colFolders.Count
    If colFolders(lItems) = strFolder Then
        colFolders.Remove (lItems)
    End If
 Next lItems
Else
 blfFoundEmpty = False
 Debug.Print strFolder
 For lEmpty = 1 To colEmptyFolders.Count
    If colEmptyFolders(lEmpty) = strFolder Then
        blfFoundEmpty = True
        'Debug.Print "found"
    End If
 Next lEmpty
 If blfFoundEmpty = False Then colEmptyFolders.Add strFolder
End If

 If bIncludeSubfolders Then
 'Fill colFolders with list of subdirectories of strFolder
 strTemp = Dir(strFolder, vbDirectory)
 Do While strTemp <> vbNullString
 If (strTemp <> ".") And (strTemp <> "..") Then
    If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
        'Debug.Print "Searching inside folder: " & strTemp
        colFolders.Add strFolder & strTemp
    End If
 End If
 strTemp = Dir
 Loop
 
'Debug.Print "Found " & colFolders.Count & " folders."

 'Call RecursiveDir function to seach each subfolder in colFolders
 For Each vFolderName In colFolders
    Debug.Print "Search: " & vFolderName
    strFolder = vFolderName
    Call RecursiveDir(colFiles, strFolder, strFileSpec, True)
    Next vFolderName
 End If
 
Exit Function
Error_Trap:
 Debug.Print Err.Number & vbTab & Err.Description
 If Err.Number = 52 Then ' Permissions denied on system folder...
 Resume Next
 ElseIf Err.Number = 53 Then ' File Not Found
 Resume Next
 Else
 MsgBox "Maybe add code to handle error: " & Err.Number & vbTab & Err.Description
 Resume Next
 End If
 End Function

Public Function TrailingSlash(varIn As Variant) As String
'ensures that the folder names we are processing end with the slash character

    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

 

[strongm]

And did you try my code?

 

[trevil620]

Jaabaar, you should try the code Strongm suggested.. I am out of town so have my laptop which does NOT have the code I was using.

I created your folder structure and Strongm's code worked. The only possible issue is that it does NOT report the root folder as containing no files (I mean C:\TestExcel is not marked as empty..)

Good luck.
Thank you Strongm

 

[jaabaar]

Hi strongm

Thank you for providing this code for me to have a look much appreciate it. As soon I click search that runs “MainExample” I get an error straight away:

Error: RunTime Error 70 – Permission denied
The error occurs in function ‘RecurseFolder” in the following code: I beleave its got to do with .FILES

For Each checkfile In oFolder.Files
        If checkfile.Name Like strFile Then
            RecurseFolder = True
            colFoundFiles.Add checkfile.Path
        End If
Next

That is a strange error produced by file as permission denied. Do you think access 2007 security is preventing this. All it is doing is checking files and writing or adjusting nothing.

MaxDepth: is set to 255. Is that the limit of searching inside a folder to a maximum subfolders of 255? If so we can control the depth lets say 20 subfolders inside a parent directory?

 

[jaabaar]

Hi trevil620 & strongm

strange I get permission denied with strongm code. I must be doing something wrong?

I really hope I can get both codes to work with your help.

again thank you to both for your valuable time and effort very much appriciated.

Thanks

 

[strongm]

>The only possible issue is that it does NOT report the root folder as containing no files

That would be correct, since the root folder contains subfolders that DO have a matching file (as per jaabar's "Folder 3 = should not show up under empty folder as its SUBfolder contains spreadsheets.")

Mind you, as it happens there is a minor bug related to that, which I've corrected. Fixed code given below.

> Do you think access 2007 security is preventing this

I tested the code in Access 2007 and Access 2010 without any problems. So, at this stage, I'm note sure what the problem might be in your environment.

>MaxDepth: is set to 255

No, it ends up as 255 as a default value if you do not chose your own value. The Remark just before the FindFile function mentions this. So, if you call FindFile as:

FindFile "c:\test", "*.txt", 20

it will only search down (a maximum of) 20 levels from the root it has been given

Here is the code that fixes the minor bug I noted, and includes the above example of limiting the recursion to a maximum of 20 levels (not that it matters here). Replace the original MainExample and FindFIle with this new code:

[blue]Public Sub MainExample()
    Dim result As Boolean
    Dim vFile As Variant
    Set colFoundFiles = New Collection
    Set colEmptyFolders = New Collection
    
    ' use your own path and file pattern here
    FindFile "f:\test", "*.txt", 20
    For Each vFile In colFoundFiles
        Debug.Print "File Found: "; vFile
    Next vFile
    
    For Each vFile In colEmptyFolders
        Debug.Print "Empty Folder: "; vFile
    Next vFile
End Sub

[green]' PathDepth controls how deep we recurse into the folder hierarchy[/green]
Private Function FindFile(strRoot As String, Optional strFile As String = "*.*", Optional PathDepth As Long = 255)
    Dim fso As New FileSystemObject
    Debug.Print "Searching for " & strFile & " in " & strRoot
    RecurseFolder fso.GetFolder(strRoot), strFile, PathDepth
    FindFile = colFoundFiles.Count > 0
    If colFoundFiles.Count = 0 Then
        colEmptyFolders.Add strRoot
        MsgBox "No file(s) found"
    End If
End Function[/blue]

 

[jaabaar]

Hi strongm

Thank you for providing this code for me to have a look much appreciate it. The code works fully as required. After thorough testing I have found out the reason it was not working at my end only was the search picked up some system files such as .ini and Default.rdp file. Strange that should have not happened.

Looks like I need to add a condition to ignore system files and folders as a precaution in case the above problem happens again. I think something like this : (If checkfile.Attributes <> Then) is that ok, need to find out how to ignore hidden files and folders. Advice would be highly valued.

Note: I do not need to make the program to search up-to 20 subfolder that was just to see how it is done.

Penultimate code:

Option Compare Database
Option Explicit

Private colFoundFiles As Collection
Private colEmptyFolders As Collection

Public Sub MainExample()
    Dim result As Boolean
    Dim vFile As Variant
    
    Set colFoundFiles = New Collection
    Set colEmptyFolders = New Collection
    
    ' place path and file pattern here.
    'if I need to limit sub-folder search (FindFile "f:\test", "*.txt", 20)

        FindFile "C:\TestExcel", "*.xlsx"
        Debug.Print "Found colFoundFiles " & colFoundFiles.Count & " files."

        For Each vFile In colFoundFiles
            Debug.Print "File Found: "; vFile
        Next vFile
        
        Debug.Print "Total empty folders " & colEmptyFolders.Count

        For Each vFile In colEmptyFolders
            Debug.Print "Empty Folder: "; vFile
        Next vFile

End Sub

Private Function FindFile(strRoot As String, Optional strFile As String = "*.*", Optional PathDepth As Long = 255)

Dim fso As New FileSystemObject
    Debug.Print "Searching for " & strFile & " in " & strRoot
    RecurseFolder fso.GetFolder(strRoot), strFile, PathDepth
    FindFile = colFoundFiles.Count > 0
    
    'if spreadsheets found say so
    If colFoundFiles.Count = 0 Then
        colEmptyFolders.Add strRoot
        Debug.Print "No file(s) found"
    End If

End Function


Private Function RecurseFolder(oFolder As Folder, strFile As String, MaxDepth As Long) As Boolean
    Dim checkfile As File
    Dim checkfolder As Folder
    Dim result As Boolean
    Static Depth As Long
    
    For Each checkfile In oFolder.Files
        If checkfile.Name Like strFile Then
            RecurseFolder = True
            colFoundFiles.Add checkfile.Path
        End If
    Next

    Depth = Depth + 1
    If Depth <= MaxDepth Then 'Only bother if we have not recursed into folder hieracrchy deeper than we wanted
        For Each checkfolder In oFolder.SubFolders
            RecurseFolder = RecurseFolder(checkfolder, strFile, MaxDepth)
            If Not RecurseFolder Then
                If Depth = 1 Then
                    colEmptyFolders.Add checkfolder.Path
                End If
            End If
        Next
    End If
    Depth = Depth - 1

End Function

 

[jaabaar]

Again thank you very much strongm.