Determine whether subfolders in specified folder path are empty - vba

Question

I am trying to do the following:
find folder based on the path given by a cell value
determine whether it's subfolders are empty
if the subfolders are all empty - put "subfolders empty" in a cell
if there are some files within any of the subfolders
put "contains files in a cell"
My code runs but it is skipping over the subfolders sub procedure.
Sub search_subfolders()
Application.ScreenUpdating = False
On Error Resume Next
With Workbooks("Folder_creator.xlsm").Sheets("Sheet1")
Dim Rng As Range
Dim Pth As String
Dim Model As String
Dim x As String
Set Rng = .Range("a2:a527")
Pth = .Range("b2").Value
For r = 2 To 527
Model = .Cells(r, 1).Text
ModelPth = Pth & Model & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubFolders FSO.ModelPth
.Cells(r, 4).Value = x
Next r
End With
Application.ScreenUpdating = True
End Sub
Sub ShowSubFolders(ModelPth)
For Each Subfolder In ModelPath.SubFolders
If Subfolder.Size = 0 Then
x = "Subfolders empty"
Else
x = "Contains files"
End If
ShowSubFolders Subfolder
Next
End Sub
I think this is something to do with trying to pass variables to it without the correct syntax.

Answer 1

Ok, there are a number of problems with your code. Please see the code below for something that should work. I tried to explain changes with comments. Feel free to comment on this post if you need me to elaborate. Good luck, hope this helps.
Also, I wasn't sure if you wanted to check your ModelPth folder or subfolders in your ModelPth folder, so I made subroutines for both. I also took the liberty of implementing some small scale error handling.
'x needs to be declared here if it is to be accessed by multiple subroutines
Private x As String
Sub search_subfolders()
Application.ScreenUpdating = False
'Removed "On Error Resume next" .... this should only be used very sparingly
'Slightly better is to only use on a short section followed by "On Error Goto 0"
'or use "On Error Goto xyz" where "xyz" is a label
Dim sheet As Worksheet
'Perhaps you do want to refer to a workbook other than the one calling this macro
'but my guess is that this is intended to run within the workbook calling in
'in which case, it's much better to use "Activeworkbook" than to rely on a name that may change
'You may want to also reconsider your use of "Sheet1", you can use Sheets(1) which has it's own problems, or use "ActiveSheet",
'or just use "Range("B2")" which, is the same as ActiveWorkbook.ActiveSheet.Range("B2")
Set sheet = ActiveWorkbook.Sheets("Sheet1")
'If code is housed under a sheet module instead of in a standard module,
'your best option is to use "Set sheet = Me" and workbook shouldn't need to be specified.
'If you do ever want to specify calling workbook, you can use "ThisWorkbook"
Dim Rng As Range
Set Rng = sheet.Range("A2:A527")
Dim Pth As String
Pth = sheet.Range("b2").Value
Dim Model As String
'It's really best to avoid using "with" statements... just declare a variable and run with that
'In this case just make a sheet variable
For r = 2 To 527
Model = sheet.Cells(r, 1).Text
ModelPth = Pth & Model & "\"
'Are you sure ModelPth is in the correct syntax?
'That is, youmay want (Pth & "\" & Model & "\") instead.
CheckSubFolderContent ModelPth
sheet.Cells(r, 4).Value = x
CheckFolderContent ModelPth
sheet.Cells(r, 5).Value = x
Next r
End Sub
Sub CheckSubFolderContent(ModelPth)
'Checks for content in subfolders in a folder specified by path
x = "No Subfolders found"
'Error handling for Model = ""
If Right(ModelPth, 2) = "\\" Then
x = "N/A"
Exit Sub
End If
Dim FSO, Parent As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set Parent = FSO.GetFolder(ModelPth)
If Err > 0 Then
x = "Error! Parent folder does not exist."
Exit Sub
End If
For Each Subfolder In Parent.SubFolders
If Subfolder.Size = 0 Then
x = "Folder has subfolders without content"
Else
x = "Folder has subfolders with content"
End If
'Why this recursive line? "ShowSubFolders Subfolder"
'Recursive calls should be avoided and are rarely necesary.
Next
If Err > 0 Then x = "Error!"
On Error GoTo 0
End Sub
Sub CheckFolderContent(ModelPth)
'Checks for content in a folder specified by path
x = "No Subfolders found"
If Right(ModelPth, 2) = "\\" Then
x = "N/A"
Exit Sub
End If
Dim FSO, Folder As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set Folder = FSO.GetFolder(ModelPth)
If Err > 0 Then
x = "Error! Parent folder does not exist."
Exit Sub
End If
If Folder.Size = 0 Then
x = "Folder is empty"
Else
x = "Folder has content"
End If
If Err > 0 Then x = "Error!"
On Error GoTo 0
End Sub

Answer 2

Couple of things you are doing wrong.
1. You are trying to access sub-folders without making FSO(FileSystemObject) accessible in ShowSubFolders sub.
2. x is not global variable and yet you are trying to access it.
3. Less conditions in ShowSubFolders sub.
Here is the updated code.
Dim FSO As Object '<-- This one sets FSO global
Dim x As String '<-- This one sets x global
Sub search_subfolders()
Application.ScreenUpdating = False
On Error Resume Next
Workbooks("Folder_creator.xlsm").Sheets("Sheet1")
Dim Rng As Range
Dim Pth As String
Dim Model As String
Set Rng = .Range("a2:a527")
Pth = .Range("b2").Value
For r = 2 To 527
Model = .Cells(r, 1).Text
ModelPth = Pth & Model & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubFolders FSO.GetFolder(ModelPth)
.Cells(r, 4).Value = x
x = ""
Next r
End With
Application.ScreenUpdating = True
End Sub
Sub ShowSubFolders(Folder)
Dim SubFolder
If Folder.SubFolders.Count > 0 Then
For Each SubFolder In Folder.SubFolders
ShowSubFolders SubFolder
If SubFolder.Size = 0 Then
x = "Subfolders empty"
Else
x = "Contains files"
End If
Next
Else
x = "Subfolders empty"
End If
End Sub