Permision Denied-VBA Code to list sub-folders

[howard]

I have the following code below, but get permission denied when running the code.

 For Each subFolder In folder.Subfolders

See full code below

 Sub ExtractSubFolderNames()
    Dim folderPath As String
    Dim fso As Object
    Dim outputRow As Integer
    Dim excludedFolders As Variant
    Dim folder As Object
   
    ' Set the folder path to the root of the C: drive
    folderPath = "C:\" ' Root directory of the C: drive
   
    ' List of folders to exclude
    excludedFolders = Array("Data", "Users", "Program Data", "Program Files", "RECYCLE")
   
    ' Initialize FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    ' Start output from row 1 on the "Subfolders" sheet
    outputRow = 1
   
    ' Attempt to get the folder and handle permission denied
    On Error GoTo PermissionDeniedHandler
    Set folder = fso.GetFolder(folderPath)
    On Error GoTo 0 ' Reset error handling
   
    ' Call the recursive function to list all subfolders
    Call ListSubFolders(folder, excludedFolders, outputRow)
   
    MsgBox "Subfolders extraction complete."
    Exit Sub

PermissionDeniedHandler:
    MsgBox "Permission denied when accessing: " & folderPath
    Resume Next ' Skip this folder and continue with the next one
End Sub

' Recursive function to list all subfolders
Sub ListSubFolders(ByVal folder As Object, ByVal excludedFolders As Variant, ByRef outputRow As Integer)
    Dim subFolder As Object
    Dim subFolderPath As String
   
    ' Loop through each subfolder
    For Each subFolder In folder.Subfolders
        subFolderPath = subFolder.Path
       
        ' Check if the subfolder is not in the excluded list
        If IsError(Application.Match(subFolder.Name, excludedFolders, 0)) Then
            ' If not excluded, output the folder path (subfolder) in column A on the "Subfolders" sheet
            ThisWorkbook.Sheets("Subfolders").Cells(outputRow, 1).Value = subFolderPath
            outputRow = outputRow + 1
        End If
       
        ' Recursively call the function to find sub-subfolders
        Call ListSubFolders(subFolder, excludedFolders, outputRow)
    Next subFolder
End Sub

It would be appreciated if someone could amend my code

 

[JEC]

See post 4 here, you can do it with a oneliner

Process files using FSO - in alphabetical order

If FSO is used to process files, can you make it do so in alphabetical order. If I run this code, normally it does in alphabetical order, but if I amend one of the files, then it changes order. It's as if both alphabvetical order and last saved or last modified is used. Sub Add_files_to_menu(cb...

www.mrexcel.com

 

[howard]

Thanks for the link, but not suitable for my needs, as I have several exclusion

I have rewritten the code and it finally works

 Sub ExtractAllSubfolders()
    Dim oFSO As Object ' FileSystemObject
    Dim rootFolder As Object ' Root Folder
    Dim ws As Worksheet
    Dim excludedFolders As Object
    Dim lastRow As Long
    
    ' Initialize worksheet and FileSystemObject
    Set ws = ThisWorkbook.Sheets("Subfolders")
    ws.Columns("A").ClearContents ' Clear previous results
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Dim rootPath As String
    rootPath = "C:\" ' Set your root path here
    
    ' Create a dictionary for excluded folder names
    Set excludedFolders = CreateObject("Scripting.Dictionary")
    excludedFolders.Add "ProgramData", True
    excludedFolders.Add "Application Data", True
    excludedFolders.Add "AppData", True
    excludedFolders.Add "$Recycle.Bin", True
    excludedFolders.Add "Windows", True
    excludedFolders.Add "Windows10Upgrade", True
    excludedFolders.Add "$WinREAgent", True
    excludedFolders.Add "4DefaultTempSaveScan", True
    excludedFolders.Add "4DThumb", True
    excludedFolders.Add "Program Files", True
    excludedFolders.Add "Program Files (x86)", True
    excludedFolders.Add "Users", True
    excludedFolders.Add "Data", True ' Add additional folders as needed
    
    ' Check if the root folder exists
    If oFSO.FolderExists(rootPath) Then
        Set rootFolder = oFSO.GetFolder(rootPath)
        lastRow = 1
        ' Start recursion
        Call ListAllSubfolders(rootFolder, ws, excludedFolders, lastRow)
        MsgBox "Subfolder extraction complete!", vbInformation
    Else
        MsgBox "The specified folder does not exist: " & rootPath, vbExclamation
    End If
End Sub

' Recursive function to list subfolders
Sub ListAllSubfolders(folder As Object, ws As Worksheet, excludedFolders As Object, ByRef lastRow As Long)
    Dim subfolder As Object
    
    On Error Resume Next ' Handle permission errors silently
    
    ' Loop through each subfolder
    For Each subfolder In folder.subfolders
        ' Skip excluded folders based on name match
        If Not ContainsExcludedFolder(subfolder.Name, excludedFolders) Then
            ' Write the full folder path to the worksheet (only subfolders, not the root)
            If folder.Path <> "C:\" Then ' Skip the root folder itself
                ws.Cells(lastRow, 1).Value = subfolder.Path
                lastRow = lastRow + 1
            End If
            ' Recursively list subfolders inside the current subfolder
            Call ListAllSubfolders(subfolder, ws, excludedFolders, lastRow)
        End If
    Next subfolder
    
    On Error GoTo 0 ' Reset error handling
End Sub

' Function to check if a folder is excluded
Function ContainsExcludedFolder(folderName As String, excludedFolders As Object) As Boolean
    Dim key As Variant
    
    ' Check if the folder name matches any excluded folder names
    For Each key In excludedFolders.Keys
        If InStr(1, folderName, key, vbTextCompare) > 0 Then
            ContainsExcludedFolder = True
            Exit Function
        End If
    Next key
    
    ContainsExcludedFolder = False
End Function

 

[JEC]

You can still exclude them if you want. After loading it into an array, you can modify that array.

But, if you really want to use your current approach, you have to catch the error in an error handler. When it errors, stop the code and evaluate your local variabels. Try to find the folder where it goes wrong.

Using an “on error resume next” will solve it directly, but you probably want to find the rootcause

 

[howard]

Thanks for your input