Гиперссылка l oop в VBA

Question

У меня проблема, потому что я хочу создать программу с гиперссылкой make для папок, у меня уже есть эта часть:

Dim a As String
Dim i As Long
Dim ark1 As Worksheet
Set ark1 = Arkusz1

For i = 1 To 3
    ark1.Cells(i, "A").Select
    a = "TR_" & i
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="C:/" & a, _
    SubAddress:="", ScreenTip:="a", TextToDisplay:=a
Next i

End Sub

Но у меня есть папки: TR_1_Jon TR_2_Allex et c. И можно сделать это l oop, чтобы Excel распознал только первую часть: «TR_1 _ ******»?

Answer 1

Вы можете использовать следующий код для анализа вложенных папок, а затем использовать его для гиперссылок:

Public Sub Test()
    Set fso = CreateObject("Scripting.FileSystemObject")
    FolderName = "D:\" 'Replace it with selected folder
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(FolderName)
    For Each oSubfolder In FSOFolder.SubFolders
            MsgBox oSubfolder
    Next oSubfolder
End Sub

РЕДАКТИРОВАТЬ:

Public Sub NonRecursiveMethod()
    Set fso = CreateObject("Scripting.FileSystemObject")
    FolderName = "D:\" 'Replace it with selected folder
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(FolderName)
    i = 1
    For Each oSubfolder In FSOFolder.SubFolders
            ActiveSheet.Cells(i, "A") = oSubfolder.Name
            Cells(i, "A").Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=oSubfolder, SubAddress:=""
            i = i + 1
    Next oSubfolder
End Sub