Populate Hyperlinks in ListBox

[Danny69]

Hello,
I am new to programming, I need this codes results in ListBox how to do that?

Sub HyperlinksToDirectory()
    Dim stDir As String
    Dim stFile As String
    Dim R As Range
    Set R = ActiveCell
    stDir = InputBox("Directory?", , Default:=CurDir())
    stFile = Dir(stDir & "\*.*")
    Do Until stFile = ""
        R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
        Set R = R.Offset(1)
        stFile = Dir()
    Loop
    R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo
End Sub

[SamT]

A ListBox can't hold hyperlinks.

What exactly are you trying to accomplish?

It looks like you're trying to populate a ListBox with file names and you want it to Open the selected file when clicked.

[Danny69]

A ListBox can't hold hyperlinks.

Okay, i was not knowing that a listox can't hold hyperlinks.

What exactly are you trying to accomplish?
It looks like you're trying to populate a ListBox with file names and you want it to Open the selected file when clicked.

Yes, I want to populate the files names on ListBox from a particular folder, & if possible when clicked the selected file it opens.

Thanks.

[Press]

Hi,

In a module include your procedure:

Sub HyperlinksToDirectory()
    Cells(1, 1).Select
    Dim stDir As String
    Dim stFile As String
    Dim R As Range
    Set R = ActiveCell
    stDir = InputBox("Directory?", , Default:=CurDir())
    stFile = Dir(stDir & "\*.*")
    Do Until stFile = ""
        R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
        Set R = R.Offset(1)
        stFile = Dir()
    Loop
    R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo
End Sub


Sub Avvia()
  UserForm1.Show
End Sub

In Userform add:

Private Sub UserForm_Initialize()
  Sheets("Foglio1").Activate
  UserForm1.ListBox1.RowSource = ""
  UserForm1.ListBox1.RowSource = "a1:a" & Range("A" & Rows.Count).End(xlUp).Row
End Sub


Private Sub ListBox1_Change()
    If ListBox1.ListIndex < 0 Then Exit Sub
    On Error Resume Next
    Range(ListBox1.RowSource).Cells(ListBox1.ListIndex + 1, 1).Hyperlinks(1).Follow
    Unload Me
    On Error GoTo 0
End Sub

[Danny69]

Thankyou, it works perfectly.