Monday, February 17, 2014

Create Hyperlinks for all Files in a Folder

Sub createHyperLink()
Dim I As Integer
Dim fl As File
Dim fldr As Folder
Dim sh As Worksheet
Dim fso As FileSystemObject
Dim path As String

With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    path = .SelectedItems(1)
    Range("A1") = "File Name"
End With

I = 2

Set fso = New FileSystemObject
Set fldr = fso.GetFolder(path)
    For Each fl In fldr.Files
        ThisWorkbook.Sheets(1).Cells(I, 1) = fl.Name
            If ThisWorkbook.Sheets(1).Cells(I, 1) = fl.Name Then
                ThisWorkbook.Sheets(1).Cells(I, 1).Select
                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fl.path
            End If
        I = I + 1
    Next fl

End Sub

No comments:

Post a Comment