Проверьте, если папка пуста

Question

Мой код должен пройти через папки / сабы и определить, есть ли там какой-либо файл.

У меня есть 2 вопроса:

1. Я не получаю никакой обратной связи, еслиВ некоторых папках НЕТ папок / подписчиков.Особый случай: если он обнаруживает файлы (не папки), предположим, что в нем есть какие-то файлы (например, Excel), программа говорит «Пустая папка»?

2. В диалоговом окне «Открыть окно»чтобы выбрать папку, если нажать кнопку «Отмена», появится всплывающее окно, в котором будет указано: «Папка не пуста ... 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

Если вы хотите сделать отдельную процедуру для выбора папки, вам необходимо определить, выбрал ли пользователь что-либо.Вы можете использовать Boolean тип возврата функции в результате действия и строку для исходной папки, которая передается по ссылке, которая будет заполнена, если папка выбрана пользователем.Вот основной код:

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