VERTICAL Sorting Order for SUB-FOLDERS

  • Hello Everyone,


    I’m trying to sort out below VBA code that is working in VERTICAL Sorting Order of SUB-FOLDERS

    Please help me to work this VBA code to work in HORIZONTAL Sorting Order of SUB-FOLDERS. I attached two photos please someone help me I really appreciate your great efforts and time.


    Thank You J


    Vertical sorting


    Image



    Horizontal sorting


    Image



    VBA code


    Public Sub Hierarchical_Folders_and_Files_Listing2()



    Dim startFolderPath As String

    Dim startCell As Range

    Dim n As Long


    startFolderPath = "Z:\Central Region (Riyadh)"


    With Sheets("Sheet1")

    .Cells.Clear

    .Activate

    Set startCell = .Range("A1")

    End With


    n = List_Folders_and_Files2(startFolderPath, startCell)



    End Sub



    Private Function List_Folders_and_Files2(folderPath As String, destCell As Range) As Long



    Static FSO As Object

    Dim thisFolder As Object, subfolder As Object

    Dim fileItem As Object

    Dim n As Long


    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")


    Set thisFolder = FSO.GetFolder(folderPath)


    'Add hyperlink for this folder


    destCell.Parent.Hyperlinks.Add Anchor:=destCell, Address:=thisFolder.Path, TextToDisplay:=thisFolder.Name



    'List subfolders in this folder


    n = 0

    For Each subfolder In thisFolder.Subfolders

    n = n + 1 + List_Folders_and_Files2(subfolder.Path, destCell.Offset(n + 1, 1))

    Next



    List_Folders_and_Files2 = n



    End Function

  • Mr. john, send me this code I hope this will work


    Option Explicit


    Public Sub Main_List_Folders_LB()


    Dim startFolderPath As String

    Dim startCell As Range, r As Long


    startFolderPath = "C:\Users\D\Desktop\TEST\CR"


    With ActiveSheet

    .Cells.Clear

    Set startCell = .Range("A1")

    End With


    r = List_Folders(startFolderPath, 1, startCell)

    Debug.Print startCell.Offset(r).Address


    End Sub



    Private Function List_Folders(folderPath As String, level As Long, destCell As Range) As Long


    Static FSO As Object

    Dim thisFolder As Object, subfolder As Object, jobSubfolder As Object

    Dim n As Long, c As Long


    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")


    Set thisFolder = FSO.GetFolder(folderPath)


    'Add hyperlink for this folder


    Debug.Print thisFolder.Path, destCell.Address

    destCell.Parent.Hyperlinks.Add Anchor:=destCell, Address:=thisFolder.Path, TextToDisplay:=IIf(Left(thisFolder.Name, 1) = "@", "'", "") & thisFolder.Name


    'List subfolders in this folder


    n = 0

    For Each subfolder In thisFolder.SubFolders

    If level <= 2 Then

    n = n + 1 + List_Folders(subfolder.Path, level + 1, destCell.Offset(n + 1, 1))

    Else

    'Add hyperlinks for job folder and its subfolders

    n = n + 1

    c = 1

    destCell.Parent.Hyperlinks.Add Anchor:=destCell.Offset(n, c), Address:=subfolder.Path, TextToDisplay:=IIf(Left(subfolder.Name, 1) = "@", "'", "") & subfolder.Name

    For Each jobSubfolder In subfolder.SubFolders

    c = c + 1

    destCell.Parent.Hyperlinks.Add Anchor:=destCell.Offset(n, c), Address:=jobSubfolder.Path, TextToDisplay:=IIf(Left(jobSubfolder.Name, 1) = "@", "'", "") & jobSubfolder.Name

    Next

    End If

    Next


    List_Folders = n


    End Function