Create hyperlink automatically from cell text value to corresponding file name on server

[Lars81]

Hi, I would like to know if there is a way to create a Macro that will automatically create dynamic hyperlink for every cell that have a text value that is corresponding to a file name in a main forder or its sub folder?

All my electronic files are stored on a server, in a main folder with many subfolders depending of the type of information.

Let’s take E1 for example (rapport1.pdf)
Right now, I’m creating the hyperlink manually: ../../A_DOCUMENTS\08_rapport\rapport1.pdf

But I would like a Macro that create the hyperlink automatically to the corresponding document if it find the text written in any cell of the worksheet as the name of a document in any subfolder of A_DOCUMENTS.

Any idea

Thanks

 

[John_w]

What do you mean by creating the hyperlink automatically? Do you mean that when you enter a text value in a cell a macro would immediately look for that cell value in the A_DOCUMENTS folder tree and create a hyperlink to the corresponding file? This could be done via the Worksheet_Change event handler. Or do you want to run a macro that would loop through all the cells and create hyperlinks to the files it finds?

Either way, one fairly fast method of searching the A_DOCUMENTS folder tree for a specific file is with a DIR /S command. I used this method here:

Search in folders/subfolders: Tweaking a previous solution

In a previous request by MM91 for how to search for a pdf in folders _and_ subfolders, @DanteAmor provided the solution below. I'm trying to adapt it to do something slightly different, specifically: I got column A which lists a number of filenames (the number of rows changes, so it'll have to...

www.mrexcel.com

A faster method would be to create an array of all the files in the A_DOCUMENTS folder tree, running the DIR /S command only once, and search the array for the required file.

 

[Lars81]

Hi John, I'll try to explain what I'm trying to do. When I say that I want the macro to create the hyperlink automatically, I mean that I’m looking for a way to run a macro that will create the hyperlink for every cell that contain a file name with its extension to the corresponding file or document stored in a specific folder and its sub folder.

I have thousands of file name with its extension already written as text in different column of my worksheet. Right now, I insert manually the hyperlink to the corresponding file one cell at a time, which is very time consuming (right click on the cell, insert hyperlink and link it to the specific document). I want to be able to access the document when I click on a specific cell of my worksheet. Let say that I have 10,000 cell to link manually to the corresponding document, that is going to take me weeks to do it manually. I'm wondering if all the hyperlink could be created in one simple step, run a macro, have all the cell with a file name written turn blue and allow me to click on them to open the document…

Thank you very much for your help!

 

[John_w]

OK, I understand; you want to run a macro manually as needed that will look at all the cells and create hyperlinks in the cells containing file names.

With 10,000 cells to create hyperlinks in the first method I envisaged would be quite slow because it would run a DIR /S command of the A_DOCUMENTS folder tree for every file name.

Here is the second method, which runs a single DIR /S command on the A_DOCUMENTS folder tree, but made faster by using a binary search of a sorted ArrayList structure.

The whole macro consists of 1 standard module and 2 class modules. You must set a reference to mscorlib.dll - on my machine this is C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb - via Tools -> References in the VBA editor.

Standard module - edit the mainFolder string where shown to be the path to the A_DOCUMENTS folder.

Option Explicit

'References required
'mscorlib.dll (C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb)


Public Sub Find_Files_Create_Hyperlinks()

    Dim mainFolder As String
    Dim cell As Range
    Dim filesArrayList As mscorlib.ArrayList
    Dim fileFoundIndex As Long
    Dim file As clsFile
    Dim fileComparer As clsFileComparer
 
    mainFolder = "../../A_DOCUMENTS\"    'PATH TO A_DOCUMENTS FOLDER - EDIT AS REQUIRED"
 
    'Get listing of all files in main folder and its subfolders and put into an ArrayList.
    'Each ArrayList item is a clsFile object which has separate properties for the file name and folder path, so that just the file name part can be searched
 
    Set filesArrayList = New mscorlib.ArrayList
    Get_Files_In_Folder mainFolder, filesArrayList
     
    'Sort the ArrayList in ascending order of file name, for fast searching using BinarySearch_3 method below
 
    'https://docs.microsoft.com/en-us/dotnet/api/system.collections.arraylist.sort?view=net-6.0
    'ArrayList.Sort(IComparer)
    'Sorts the elements in the entire ArrayList using the specified comparer.
 
    Set fileComparer = New clsFileComparer
    filesArrayList.Sort_2 fileComparer
   
    Set file = New clsFile

    For Each cell In ActiveSheet.UsedRange
     
        If InStr(cell.Value, ".") Then
     
            'Put this cell's value (the file name being sought) in a clsFile structure and search for it in filesArrayList using a binary search
         
            file.fileName = cell.Value
            file.folderPath = ""
         
            'https://docs.microsoft.com/en-us/dotnet/api/system.collections.arraylist.binarysearch?view=net-6.0
            'ArrayList.BinarySearch(Object, IComparer)
            'Searches the entire sorted ArrayList for an element using the specified comparer and returns the zero-based index of the element.
            'Returns:
            'The zero-based index of value in the sorted ArrayList, if value is found; otherwise, a negative number, which is the bitwise complement of the
            'index of the next element that is larger than value or, if there is no larger element, the bitwise complement of Count.
         
            fileFoundIndex = filesArrayList.BinarySearch_3(file, fileComparer)
         
            If fileFoundIndex >= 0 Then
                Set file = filesArrayList(fileFoundIndex)
                cell.Worksheet.Hyperlinks.Add Anchor:=cell, Address:=file.folderPath & file.fileName, TextToDisplay:=cell.Value
            Else
                'file not found
            End If
         
        End If
     
    Next
    
End Sub


Private Sub Get_Files_In_Folder(folderPath As String, filesArrayList As mscorlib.ArrayList)

    Dim WSh As Object   'WshShell
    Dim command As String
    Dim files As Variant
    Dim file As clsFile
    Dim i As Long, p As Long
 
    Set WSh = CreateObject("WScript.Shell")                'New WshShell

    'Get list of all files in specified folder and its subfolders
 
    command = "cmd /c DIR /S /B " & Chr(34) & folderPath & Chr(34)
    files = Split(WSh.Exec(command).StdOut.ReadAll, vbCrLf)
 
    'Put the files in an ArrayList.  Each file item is a clsFile object
 
    For i = 0 To UBound(files) - 1
        p = InStrRev(files(i), "\")
        Set file = New clsFile
        file.fileName = Mid(files(i), p + 1)
        file.folderPath = Left(files(i), p)
        filesArrayList.Add file
    Next
 
End Sub

Class module, renamed as clsFile

Option Explicit

Public fileName As String
Public folderPath As String

Class module, renamed as clsFileComparer

Option Explicit

Implements mscorlib.IComparer

'Compare the fileName string property of two clsFile objects
'Returns:
'   -1      file1.fileName is less than file2.fileName
'   0       file1.fileName is equal to file2.fileName
'   1       file1.fileName is greater than file2.fileName

Private Function IComparer_Compare(ByVal file1 As Variant, ByVal file2 As Variant) As Long
    IComparer_Compare = StrComp(file1.fileName, file2.fileName, vbTextCompare)
End Function

Private Sub IComparer_TypeCheck(ByVal CurrentVarType As VbVarType, Example As Variant)
    'This second interface callback routine is not used
End Sub