檢查文件夾是否為空

Question

我的代碼應遍歷Folders / Subs，並確定其中是否有任何文件。

我有兩個問題：

1. 如果某些文件夾中沒有文件夾/訂閱，我沒有收到任何反饋。 一種特殊情況：如果它檢測到文件（不是文件夾），則假定程序中顯示“ Empty Folder”（空文件夾），其中包含一些文件（例如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