确定指定文件夹路径中的子文件夹是否为空 [英] Determine whether subfolders in specified folder path are empty

问题描述

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

I am trying to do the following:

• 根据单元格值给出的路径查找文件夹
• 确定子文件夹是否为空
• 如果子文件夹全部为空，请在单元格中将子文件夹为空"
• 如果任何子文件夹中有一些文件
• 放置在单元格中包含文件"

我的代码运行了，但是它跳过了子文件夹子过程.

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.

推荐答案

好的，您的代码有很多问题.请查看下面的代码，了解一些可行的方法.我试图用评论解释变化.如果您需要我详细说明，请随时评论此帖子.祝您好运，希望对您有所帮助.

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.

此外，我不确定您是否要检查ModelPth文件夹或ModelPth文件夹中的子文件夹，因此我为这两个子程序创建了子例程.我还自由地实施了一些小规模的错误处理.

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

这篇关于确定指定文件夹路径中的子文件夹是否为空的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！