Add a hyperlink and display click here to open

[josros60]

Hi,

How can I modify the code below to add besides file name, last date modify and the next column to add hyperlink to the file and display "click here to open"

Sub ListFilesContainingSearchTerms()

    Dim folderName As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .InitialFileName = Application.DefaultFilePath & "\" 'change the initial folder as desired
        If .Show = 0 Then Exit Sub 'user cancelled
        folderName = .SelectedItems(1)
    End With
   
    Dim wrd As String
    wrd = InputBox("Insert one or more search terms, separated by a semi-colom (ie. blue;red;green).", "Search Terms")
    If wrd = "" Then
        MsgBox "???", vbQuestion, "Search Terms"
        Exit Sub
    End If
   
    Cells.ClearContents 'clear contents of active worksheet for new list of files
   
    Dim searchTerms As Variant
    searchTerms = Split(Trim(wrd), ";") 'Trim() to remove any leading and trailing spaces, and Split() to split the string into an array
   
    Dim startRow As Long
    startRow = 1 'change the starting row as desired
   
    Dim fileCount As Long
    fileCount = 0
   
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    ProcessFolder fso, folderName, True, searchTerms, startRow, fileCount

    MsgBox "Number of files that match the search terms: " & fileCount, vbInformation, "File Count"
 
    Set fso = Nothing
   
End Sub

Private Sub ProcessFolder(ByVal fso As Object, ByVal folderName As String, ByVal includeSubfolders As Boolean, ByRef searchTerms As Variant, ByRef rowNumber As Long, ByRef fileCount As Long)

    Dim currentFolder As Object
    Dim currentSubFolder As Object
    Dim currentFile As Object
   
    Set currentFolder = fso.GetFolder(folderName)
   
    For Each currentFile In currentFolder.Files
        If isMatchFound(currentFile.Name, searchTerms) Then
            Cells(rowNumber, "A").Value = currentFile.Name
            Cells(rowNumber, "B").Value = currentFile.DateLastModified
            FileDate = Format(currentFile.DateLastModified, "YYYYMMDD")
            rowNumber = rowNumber + 1
            fileCount = fileCount + 1
        End If
    Next currentFile
   
    If includeSubfolders Then
        For Each currentSubFolder In currentFolder.subfolders
            ProcessFolder fso, currentSubFolder, True, searchTerms, rowNumber, fileCount
        Next currentSubFolder
    End If
   
End Sub

Private Function isMatchFound(ByVal fileName As String, ByVal searchTerms As Variant) As Boolean

    Dim i As Long
   
    For i = LBound(searchTerms) To UBound(searchTerms)
        If UCase(fileName) Like "*" & UCase(searchTerms(i)) & "*" Then 'case-insensitive match
            isMatchFound = True
            Exit Function
        End If
    Next i
   
    isMatchFound = False

End Function

Thank you

 

[Domenic]

Try the following . . .

ActiveSheet.Hyperlinks.Add Anchor:=Cells(rowNumber, "C"), Address:=currentFile.Path, TextToDisplay:="click here to open"

Hope this helps!

 

[josros60]

Thank you so much, Domenic.

worked perfectly.

 

[Domenic]

You're very welcome, cheers!