Link oluşturma yardım lütfen

[darkvenue]

Merhabalar ekteki gibi bir sorunum var. Yardimlarinizi bekliyorum

Bir klasor icinden baska klasorler var ve ben bu klasorleri ve klasorlerin icindeki dosya adlarini ve dosya yollarini linklemek istiyorum.
Bu dosyada var olan makro dosya adi ve linkleme icin ise yariyor (link ve dosya adi sayfasindaki).. Ancak benim istedigim. Her klaorun ayni zamanda linklenmesi ve
ve kendi arasinda gruplandirilmasi.. Bun yapabilmek icin eklemem gereken kod nedir. Yardimci olmanizi rica ederim.


Bu koda nasıl bir ilave yapılmalıdır ?

Sub Dosya_Listele()
Columns("A:B").End(xlUp).Offset(1, 0).ClearContents
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Please Select Folder", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
Liste (Kaynak)
Set Klasor = Nothing
MsgBox "OK"
Else
Atla:
MsgBox "Please Select Folder !", vbInformation, "DIKKAT"
End If
End Sub

Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long, n As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(yol).Files
If Right(yol, 1) <> "\" Then ekle = "\"
On Error Resume Next
For Each Dosya In fs
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("a1:a" & Rows.Count)) + 1
Cells(j, 2) = yol & ekle & Dosya.Name
Cells(j, 1) = Dosya.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(j, 2), Address:=yol & ekle & Dosya.Name, TextToDisplay:=yol
Next
On Error GoTo sonraki
For Each f In fL
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub