Question

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

根据单元格值
确定它的子文件夹是否为空
如果子文件夹全部为空 - 将“子文件夹为空”放在单元格中
如果任何子文件夹中有某些文件
将“包含文件放在单元格中”

我的代码运行但正在跳过子文件夹子过程。

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

我认为这与尝试在没有正确语法的情况下传递变量有关。

Answer 1

你做错事情 1.您试图访问子文件夹而不在ShowSubFolders sub中访问FSO（FileSystemObject） 2. x不是全局变量，但您正试图访问它 3. ShowSubFolders sub中的条件较少。

这是更新的代码。

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

Answer 2

好的，您的代码存在许多问题。请参阅下面的代码，了解应该有用的内容。我试着用评论来解释变化。如果您需要我详细说明，请随意评论这篇文章。祝你好运，希望这会有所帮助。

另外，我不确定您是否要检查ModelPth文件夹中的ModelPth文件夹或子文件夹，因此我为两者创建了子例程。我也冒昧地实施了一些小规模的错误处理。

'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

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

2 个答案: