Include Path's with more than 260 characters

[Disco10]

Hi,

A couple of days ago I found a VBA Macro to gather a list of all Folders, Subfolders and Files in a directory, which works just fine (VBA to List all Folders, Subfolders and files in a directory). However, when I try to use it now on a different folder I only receive the main folder name which is as I assume due to reaching the limit to the path. The code still works on other folders with less subfolders. As I am no expert in Macro in Excel yet, I would like to ask for help.

Can someone help me with adjust the following code so that it will include the paths of all folders and subfolders in my directory?

Sub sbListAllFolderDetails()
    
    'Disable screen update
    Application.ScreenUpdating = False
    
    'Variable Declaration
    Dim shtFldDetails As Worksheet
    Dim sRootFolderName As String
    
    'Browse Root Folder
    sRootFolderName = sbBrowesFolder & ""
    
    'If path is not available, it display message and exit from the procedure
    If sRootFolderName = "\" Then
        MsgBox "Please select folder to find list of folders and Subfolders", vbInformation, "Input Required!"
        Exit Sub
    End If
    
    'Delete Sheet if it exists
    Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Sheets("Folder Details").Delete
    Application.DisplayAlerts = True
    
    'Add new Worksheet and name it as 'Folder Details'
    With ThisWorkbook
        Set shtFldDetails = .Sheets.Add(after:=.Sheets(.Sheets.Count))
        shtFldDetails.Name = "Folder Details"
    End With
    
    'Create object for sheet name
    Set shtFldDetails = Sheets("Folder Details")
    
    'Clear Sheet
    shtFldDetails.Cells.Clear
    
    'Main Header and its Fomat
    With shtFldDetails.Range("A1")
        .Value = "Folder and SubFolder Details"
        .Font.Bold = True
        .Font.Size = 12
        .Interior.ThemeColor = xlThemeColorDark2
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
    End With
    
    With shtFldDetails
        'Merge Header cells
        .Range("A1:E1").Merge
    
        'Create Headers
        .Range("A2") = "Folder Path"
        .Range("B2") = "Folder Name"
        .Range("C2") = "Number of Subfolders"
        .Range("D2") = "Number of Files"
        .Range("E2") = "Folder Size"
        
        .Range("A2:E2").Font.Bold = True
    End With
    
    'Call Sub Procedure
    'List all folders & subfolders
    sbListAllFolders sRootFolderName
    
    'Enable Screen Update
    Application.ScreenUpdating = True
    
End Sub

Sub sbListAllFolders(ByVal SourceFolder As String)
    
    'Variable Declaration
    Dim oFSO As Object, oSourceFolder As Object, oSubFolder As Object
    Dim iLstRow As Integer
            
    'Create object to FileSystemObject
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oSourceFolder = oFSO.GetFolder(SourceFolder)
    
    'Define Start Row
    iLstRow = Sheets("Folder Details").Cells(Sheets("Folder Details").Rows.Count, "A").End(xlUp).Row + 1
    
    'Update Folder properties to Sheet
    With Sheets("Folder Details")
        .Range("A" & iLstRow) = oSourceFolder.Path
        .Range("B" & iLstRow) = oSourceFolder.Name
        .Range("C" & iLstRow) = oSourceFolder.SubFolders.Count
        .Range("D" & iLstRow) = oSourceFolder.Files.Count
        .Range("E" & iLstRow) = oSourceFolder.Size
    End With
        
    'Loop through all Sub folders
    For Each oSubFolder In oSourceFolder.SubFolders
        sbListAllFolders oSubFolder.Path
    Next oSubFolder
    
    'Autofit content in respective columns
    Sheets("Folder Details").Columns("A:E").AutoFit
    
    'Release Objects
    Set oSubFolder = Nothing
    Set oSourceFolder = Nothing
    Set oFSO = Nothing


End Sub

Public Function sbBrowesFolder()
    Dim FldrPicker As FileDialog
    Dim myPath As String
        
    'Browse Folder Path
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
      With FldrPicker
        .Title = "Browse Root Folder Path"
        .AllowMultiSelect = False
          If .Show <> -1 Then Exit Function
          myPath = .SelectedItems(1) & "\"
      End With
 
      sbBrowesFolder = myPath
      If myPath = vbNullString Then Exit Function

End Function

 

[GlennUK]

Do you get any error messages? Have you tried debugging your code?

 

[Bosquedeguate]

Your problem might be this …
A worksheet cell can have no more than 255 characters.

You should test the length of the path string before copying it to the target cell. If it is longer than 255 characters you should split it up into several cells.

 

[Peter_SSs]

A worksheet cell can have no more than 255 characters

From Microsoft's Excel limits & specifications:

 

[Bosquedeguate]

sorry for the previous Post; you are limited to 255 characters in a header or footer.