确定指定文件夹path中的子文件夹是否为空

我正在尝试执行以下操作：

• 根据单元格值给出的path查找文件夹
• 确定它的子文件夹是否为空
• 如果子文件夹全部为空 – 将“子文件夹为空”置于单元格中
• 如果有任何子文件夹中有一些文件
• 把“包含文件在一个单元格”

我的代码运行，但它跳过子文件夹子程序。

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 

我认为这是与尝试将variables传递给它没有正确的语法。

Answer 1

好的，你的代码有很多问题。 请参阅下面的代码，了解一些应该起作用的东西。 我试图用评论来解释变化。 如果您需要我详细说明，请随时对此帖发表评论。 祝你好运，希望这会有帮助。

此外，我不确定是否要检查ModelPth文件夹中的ModelPth文件夹或子文件夹，所以我为这两个文件夹创build了子例程。 我还冒昧地实施了一些小规模的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

你正在做错事情的情侣。
1.您正在尝试访问子文件夹，而无需在ShowSubFolders子目录中访问FSO（FileSystemObject）。
2. x不是全局variables，但您正在尝试访问它。
3.在ShowSubFolders子条件较less。

这里是更新的代码。

 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