Excel VBA将路径排序并分组到文件夹中

Question

以下代码：

Sub cmdList()
Dim sPath   As String
Dim fOut    As Variant
Dim r       As Integer
Dim Cell As Range

With Application.FileDialog(msoFileDialogFolderPicker) '.Title = "Select directory"
    .InitialFileName = ThisWorkbook.Path & "\"
    .AllowMultiSelect = False
    If .Show = 0 Then Exit Sub
    sPath = .SelectedItems(1)
End With
Cells(4, 1) = sPath
fOut = Split(CreateObject("WScript.Shell").exec("cmd /c dir """ & sPath & """ /a:-h-s /b /s").StdOut.ReadAll, vbNewLine) 'List all

r = 5: Range(r & ":" & Rows.Count).Delete
Cells(r, 2).Resize(UBound(fOut), 1).Value = WorksheetFunction.Transpose(fOut)
End Sub

排序后产生以下输出：

然后，我想将这些路径转换为超链接，并根据文件夹名称进行分组。输出如下：

我尝试使用文件系统对象，但是在网络上速度太慢。 Shell脚本要快得多。我需要其他的帮助！

谢谢。