VBA Create hyperlinks to files in folders from matching contents of cells with same folders name

[heyheyhero]

Hi Mr Excel community, this is my first time for posting a learning discussion with Excel experience. Though I know the topic about matching(look up) and hyperlinks in VBA Excel has been repeated a lot. I have a macros that I would love to ask on how to code which I will explain the criteria of it down below with a picture for better visual explanation.

• The main job of the macro is to create a hyperlink for the file (e.g *.pdf, *.*) inside the folder, which folder's name matches with the content of the target cell in the the worksheet.
• This macro will be assign to a shape in the worksheet for executing the macro.
• When the macro run, first thing the macro should ask is the directory of the root folder which contain the sub folders, the sub folders' names are values that if match the the content of the target cell, create a hyperlink and open the file inside that matched sub folder.
• When click on the hyperlink should open the file instead of open the folder directory.

I have done a bit of research regards to my learning for this macro. So far I have been able to create the windows popup for root folder directory. However, have not made any progress in how to create the logic for macro to match between folder name and cell content.



Thank you in advance for your help on my post.

Here is the brief picture to explain the situation.

 

[sijpie]

I understand that the macro looks at the value in column a, and then tries to find the name of the file in the subdirectory with that number.
I don't understand that the the name Nitric should link to Acid.pdf.

• Does each subdirectory (1,2,3 etc) only contain one file that needs to be hyperlinked? (so the name of the file has nothing to do with the name in column B)
• Or do you want the macro to ask you to select the file that needs to be hyperlinked?

 

[heyheyhero]

I understand that the macro looks at the value in column a, and then tries to find the name of the file in the subdirectory with that number.
I don't understand that the the name Nitric should link to Acid.pdf.

• Does each subdirectory (1,2,3 etc) only contain one file that needs to be hyperlinked? (so the name of the file has nothing to do with the name in column B)
• Or do you want the macro to ask you to select the file that needs to be hyperlinked?

Hi sijpie, thank you for your reply:

• In the subdirectory there will be only 1 pdf file and yes the name fils has nothing to do with the name in column B. It is all about the content in column A match with the name of the subdirectory.
• Well not asking but automatically hyperlinked and can be access the only pdf inside according subdirectory. The root directory selection I have mange to sort it out so now I am pretty much struggle on how to hyperlinked the pdf file inside the subdirectory which name match the value from column A.

 

[sijpie]

When you select the first cell where the hyperlink needs to bbe added, the macro will run down the column to add these.

Option Explicit



Sub CreateHyperL()
    ' Creates hyperlinks in columnfrom the filenames found in the _
      subdirectories in the column two to the left
      
    Dim sPathRoot As String, sSubDir As String, sFileName As String
    Dim lR As Long
    
    
    'Check if there is a subdir name two cells to the left
    sSubDir = ActiveCell.Offset(0, -2).Value
    If Len(sSubDir) = 0 Then
        MsgBox "Check the position of the selected cell. " & vbCrLf & _
                "It should be where the hyperlink is to be placed. " & vbCrLf & _
                "The macro expects that the subdir for the link is two cells to the left.", _
                Title:="No subdir name found", _
                Buttons:=vbCritical + vbOKOnly
        Exit Sub
    End If
    
    'Get the root folder
    
    sPathRoot = GetFolder & "\"
    If CheckDirectory(sPathRoot & sSubDir) = False Then
        MsgBox sSubDir & " can not be fond as a subdirectory in " & sPathRoot, _
                Title:="Subdir not found", _
                Buttons:=vbCritical + vbOKOnly
        Exit Sub
    End If
    
    'Now go down the column until no entries to the left
    Do While Len(sSubDir) > 0
        sFileName = GetFirstFileName(sPathRoot & sSubDir)
        
        'place hyperlink in current cell
        ActiveSheet.Hyperlinks.Add Anchor:=Selection.Offset(lR, 0), Address:= _
            sPathRoot & sSubDir & "\" & sFileName, _
            TextToDisplay:="Yes"
        lR = lR + 1
        sSubDir = ActiveCell.Offset(lR, -2).Value
        
    Loop
    
End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the Root Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Function CheckDirectory(sPathName As String) As Boolean
    Dim sCheckDir As String
    
    sCheckDir = Dir(sPathName, vbDirectory)
    
    CheckDirectory = sCheckDir <> ""

End Function

Function GetFirstFileName(sPathName As String) As String
    
    GetFirstFileName = Dir(sPathName & "\*.pdf")
End Function