Rozbudowa kodu Visual Basic hiperlinki w excelu

0

Cześć
Czy mogę prosić o pomoc w rozbudowie kodu widocznego poniżej?

Kod służy do tworzenia hiperłączy w excelu. Po uruchomieniu wybieramy folder, a w komórkach pojawiają się nazwy plików z linkami do nich. Chciałbym rozszerzyć funkcjonalność tego kodu, aby po wybraniu folderu linki tworzyły się również do plików znajdujących się w podfolderach (wszystkich niezależnie od głębokości)

Sam nie umiem tego zrobić bo nie znam się na programowaniu.

  Dim xFSO As Object
  Dim xFolder As Object
  Dim xFile As Object
  Dim xFiDialog As FileDialog
  Dim xPath As String
  Dim I As Integer
  Set xFiDialog = Application.FileDialog(msoFiledialogFolderPicker)
  If xFiDialog.Show = -1 Then
      xPath = xFiDialog.SelectedItems(1)
  End If
  Set xFiDialog = Nothing
  If xPath = "" Then Exit Sub
  Set xFSO = CreateObject("Scripting.FileSystemObject")
  Set xFolder = xFSO.GetFolder(xPath)
  For Each xFile In xFolder.Files
      I = I+1
      ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
Next
End Sub```


Źródło kodu:
https://www.youtube.com/watch?v=E57j4UXDIFo
2
Sub x()
  Dim xFiDialog As FileDialog
  Dim sPath As String
  Dim i As Long
  
  Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
  
  If xFiDialog.Show = -1 Then
      sPath = xFiDialog.SelectedItems(1)
  End If
  
  Set xFiDialog = Nothing
  
  If sPath = "" Then Exit Sub
  
   i = 0
   AddFolderHyperlinks i, sPath
  
End Sub

Sub AddFolderHyperlinks(ByRef i As Long, path As String)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(path)
For Each objFile In objFolder.Files
    i = i + 1
    
    'najpierw pliki
    AddHyperlink Cells(i, 1), objFile.path, objFile.name
    
Next

For Each objFile In objFolder.SubFolders
    'potem podkatalogi
    AddFolderHyperlinks i, objFile.path

Next

End Sub

Sub AddHyperlink(cell As Range, path As String, name As String)

cell.Worksheet.Hyperlinks.Add cell, path, , , name

End Sub

1 użytkowników online, w tym zalogowanych: 0, gości: 1