简体   繁体   中英

Check if the folder is empty

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM