Hyperlink to open pdf in same directory

[acowl]

I have a spreadsheet "Contracts.xls" and I would like to be able to open PDFs via a hyperlinked cell on each row. The PDFs are stored in the same directory as the spreadsheet. For example, for contract 0001 I have a pdf in the same directory named 0001.pdf.

The path to the directory will change for each user in my organisation, so I don't want to use the full file path to open the PDFs. I would like the hyperlink to only take into account the folder that the spreadsheet is stored in.

Thanks!

 

[decadence]

Where is the folder located?

 

[acowl]

On Google Drive. Therefore the filepath for each user will be different (something like Users>Company Name>User>Google Drive>Contracts) for example, with each 'User' being different.

 

[decadence]

Perhaps something like this

    Dim strPath As String
    strPath = Environ("HomeDrive") & Environ("HomePath") & "\Desktop\" 
'Change where the folder is located i.e "\Documents\Company\Contracts\"
'Your Code....
End Sub

 

[acowl]

Ah, I don't even know where to start understanding something like that I'm afraid. I was hoping a formula would do the trick. I know it used to be quite simple to do in older versions of Excel using formulas and I hoped the method had just changed. I was hoping a variation of something like this would work: https://stackoverflow.com/questions...erlink-to-file-in-same-directory-as-xlsx-file

Is it definitely impossible to do without code?

 

[decadence]

It probably is possible but formula is not my strong suit, However give this a go....

Sub GetDoc()
Dim strPath As String
Dim MyValue As Variant
    Application.ScreenUpdating = False
        Selection.NumberFormat = "@"
        MyValue = InputBox("Enter Contract Document Number", "Contracts")
        If MyValue = "" Then
        MsgBox "HyperLink not created!"
    Exit Sub
    End If
        strPath = Environ("HomeDrive") & Environ("HomePath") & "\Desktop\Contracts\" ' Change As Required
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strPath, TextToDisplay:=MyValue
    Application.ScreenUpdating = True
End Sub