检查文件夹是否为空

Question

My code should loop through Folders/Subs and determine if there is any file there.

I have 2 questions:

1. I am not getting any feedback if there are NO Folders/Subs in certain Folders. A specific case: If it detects files (not Folders), assume there are some files (Excel for instance) in it the program says "Empty Folder"?

2. On the Open Window dialog to select a Folder, if I click Cancel it gives me a Popup window stating: "Folder not empty..blabla..."

Sub Button1_click()

Dim FileSystem As Object
Dim HostFolder As String
Dim Answer As String
Dim fs, strFolderPath, oFolder

' *** Folder with Files to perform an action ***
HostFolder = GetSourceFolder()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' *** This is your folder to define ***
    Set fs = CreateObject("Scripting.FileSystemObject")
    strFolderPath = Application.ActiveWorkbook.Path
    Set oFolder = fs.getfolder(strFolderPath)
        If (oFolder.SubFolders.Count = 0) Then

' *** If folder is empty/full message ***
' * Folder is Empty *
       MsgBox "Folder is empty!", vbOKOnly + vbInformation, "Information!"

        Else
' * Folder isn't empty *
       Answer = MsgBox("Folder not empty! Proceed with Macro?", vbYesNo + vbInformation + vbDefaultButton1, "Information!")
        If Answer = vbNo Then Exit Sub
    End If

Set fs = Nothing

Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Dim targetFolder As String
    targetFolder = GetTargetFolder()

    DoFolder FileSystem.getfolder(HostFolder)

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub


Function GetSourceFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select Source Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetSourceFolder = sItem
    Set fldr = Nothing
End Function

Function GetTargetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select Output Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetTargetFolder = sItem
    Set fldr = Nothing
End Function

Answer 1

If you want to make separate procedure for selecting folder, you need to determine whether user selected anything. You can use Boolean return type of the function as a result of action and string for source folder which is passed by reference, which will be filled if user selected folder. Here's the basic code:

Sub Test()

    Dim sourceFolder As String

    '// Usage
    If Not GetSourceFolder(sourceFolder) Then
        MsgBox "No folder selected", vbExclamation
        Exit Sub
    End If

    '// Go on with your code

End Sub

Function GetSourceFolder(ByRef sourceFolder As String) As Boolean
    '// By default function will return False
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            sourceFolder = .SelectedItems(1)
            GetSourceFolder = True
        End If
    End With
End Function