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

I copied VBA CODE from below link

File and Folder Index with Hyperlinks

horizontal sorting

Image

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