Adding hyperlinks in specified cell from subfolders

Question

I want to make a macro that will add hyperlink for specified cell (based on the text in that cell). For example if cell A1 contains text "Document1", the macro will search for Document1.pdf file in specified folder path and it's subfolders. For now I only have a macro that works with exact folder path and I want to make it more universal for the future.

    Private Sub Workbook_Open()

Dim lastRow As Long
Dim myPath As String, fileName As String

myPath = "\\192.168.00.01\My main folder\Documents\General\My files\" 'SET TO WHERE THE FILES ARE LOCATED

lastRow = Range("A800").End(xlUp).Row

For i = 2 To lastRow

    fileName = myPath & Range("A" & i).Value & "*.pdf"
    
    If Len(Dir(fileName)) <> 0 Then 'IF THE FILE EXISTS THEN
    
        ActiveSheet.Hyperlinks.Add Range("A" & i), myPath & Dir(fileName)
    
    End If
    
Next
End Sub

So your question is not about adding a Hyperlink but how to search for a file? — FunThomas, Jun 30 '20 at 08:45
'Make it more universal' is a little vague, but I'd suggest having a look at https://stackoverflow.com/questions/20687810/vba-macro-that-search-for-file-in-multiple-subfolders for searching within subfolders, then set your initial path name to "C:/Users" or something. That could slow it down considerably though. — Spencer Barnes, Jun 30 '20 at 09:42
Do you want to iterate between all pdf files and write their name and create a hyperlink to target the cell text path? Otherwise, it is not possible to match some names with what Dir iteration offers... Can you think a little about my thoughts and better explain which is your goal? — FaneDuru, Jun 30 '20 at 09:44

score 0 · Answer 1 · edited Jul 02 '20 at 09:49

0

You can always add to your worksheet a cell with path location, let it be A1, and then get that value to your macro like this : myPath = Range("A1").Value

edited Jul 02 '20 at 09:49

Puck

2,080
4
19
30

answered Jun 30 '20 at 08:56

Delaira

1
1

I don't think that will solve my problem, because I would like to avoid creating new table. I'm searching for an idea how to improve my code, so it will do what I want. – dolik22 Jun 30 '20 at 10:47

FaneDuru · Answer 2 · 2020-06-30T17:08:30.980

Not very clear 'what you want', but the next approach will surely improve your code, I think. It will iterate between the existing cells in column A:A and search for a match in the main folder and its sub folders. When a match is found, a hyperlink is created, displaying the folder path like ScreenTip (when move the cursor over the cell). Please, use the next approach:

Create the nextPrivate variables on top of module keeping the code (in the declarations area):

    Private iCountHyp As Long, boolFound As Boolean, arrFound As Variant

Use the main sub, able to call the recursive Sub and the one creating hyperlinks for each cell value (in column A:A):


    Sub testAddHypLinExistingNames()
      Dim sh As Worksheet, strMainFolder As String, lastRow As Long, i As Long
      
      strMainFolder = "\\192.168.00.01\My main folder\Documents\General\My files" 'without backslash at the end...
      'strMainFolder = "C:\Teste VBA Excel\TestPDF"
      Set sh = ActiveSheet 'use here your sheet
      lastRow = sh.Range("A" & Rows.count).End(xlUp).row
      ReDim arrFound(lastRow - 1)
      iCountHyp = 0
      
       For i = 2 To lastRow
            boolFound = False
            GetFold sh, strMainFolder, "pdf", sh.Range("A" & i)
       Next i
    End Sub

The above Sub uses the next two Subs for recursive folders find and apply Hyperlink. Of course, they must be copied in the same module:


    Private Sub GetFold(sh As Worksheet, strFolder As String, strExt As String, Optional rng As Range) 'recursive
     Dim fld As Object, subFld As Object, oFSO As Object
     
     If boolFound Then Exit Sub
     Set oFSO = CreateObject("Scripting.FileSystemObject")
     Set fld = oFSO.GetFolder(strFolder)
    
     getFilesHyperlink sh, strFolder, strExt, IIf(Not rng Is Nothing, rng, "")
     For Each subFld In fld.SubFolders
         If boolFound Then Exit Sub
         GetFold sh, subFld.path, strExt, IIf(Not rng Is Nothing, rng, "")
     Next
    End Sub


    Private Sub getFilesHyperlink(sh As Worksheet, strFolder As String, strExt As String, Optional rng As Range)
        Dim MyFolder As Object, f As Object, oFSO As Object, boolF As Boolean, El As Variant
        
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set MyFolder = oFSO.GetFolder(strFolder)
        For Each f In MyFolder.Files
            If LCase(oFSO.GetExtensionName(f.Name)) = "pdf" Then
                If Not rng Is Nothing Then
                    If f.Name = rng.Value Then
                        For Each El In arrFound
                            If El = rng.Value Then boolF = True: Exit For
                        Next
                        If Not boolF Then
                            sh.Hyperlinks.aDD Anchor:=rng, address:=strFolder & "\" & f.Name, _
                                              ScreenTip:=strFolder, TextToDisplay:=rng.Value
                            boolFound = True: arrFound(iCountHyp + 1) = rng.Value: iCountHyp = iCountHyp + 1
                            rng.Offset(, 1).Value = "OK"
                            Exit Sub
                        End If
                    End If
                Else
                    sh.Hyperlinks.aDD Anchor:=sh.Range("A" & iCountHyp), address:=strFolder & "\" & f.Name, _
                    ScreenTip:=strFolder, TextToDisplay:=f.Name
                    iCountHyp = iCountHyp + 1
                End If
            End If
        Next
    End Sub

The result will look as in the picture:

Many thanks for your help! I have one more question what should I change if I don't want to change the value of cells (A). There are my documents name and I want only to add hyperlink, without changing the text in cells. :) — dolik22, Jun 30 '20 at 13:17
@dolik22: Not complicated to do that, but I am afraid that you did not understand the code logic... It really creates new links for all pdf files found in the main folder and its sub folders. You cannot follow your initial way of thinking, I am afraid. A cell Hyperlink **cannot follow an address containing a wildcard**! Even if it will be possible (I can make a hyperlink calling a function) it is very possible to create confusions when try opening `"Test1" & "*" & ".pdf"`, when `Test10.pdf` may exist... Anyhow, if you want to keep the irrelevant existing name, replace `TextToDisplay:=f.Name`. — FaneDuru, Jun 30 '20 at 13:29
@dolik22: No space in the previous comment for the replacement... So, replace `TextToDisplay:=f.Name` with `TextToDisplay:=sh.Range("A" & iCountHyp).Value`. But this will not help at all. **Please, try to understand the code logic**... If you need to skip some existing files, you can do that inside the code, according to a skipping specific logic. — FaneDuru, Jun 30 '20 at 13:31
@dolik22: Adapted the above answer to answer your question as you formulate it. It will iterate between existing cells value of column A:A and create hyperlink, keeping the text value, when a match has been found. **Only a match is taken in consideration**. The code can be adapted to also receive more matches (for different paths), but is complicated for this phase. Please, test it and send some feedback. — FaneDuru, Jun 30 '20 at 17:10
@dolik22: Did you find some time to test the above solution? — FaneDuru, Jul 01 '20 at 07:30

Adding hyperlinks in specified cell from subfolders

2 Answers2