Question

我的代码应遍历Folders / Subs，并确定其中是否有文件。

我有2个问题：

如果某些文件夹中没有文件夹/订阅，我没有得到任何反馈。一种特殊情况：如果它检测到文件（而不是文件夹），则假定程序中显示“ Empty Folder”（空文件夹）？
在“打开窗口”对话框中选择一个文件夹，如果单击“取消”，则会弹出一个窗口，提示：“文件夹不为空。.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

检查文件夹是否为空

1 个答案: