Simplifying hyperlink creation with VBA

imega

New Member
Joined
Jul 14, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hello, could someone please write me a macro for creating a hyperlink to a pdf document from folder "H:\Scan\pdf\". Everyday I'm adding many hyperlinks to pdf documents I scanned and its very tedious. It would be great if I could click a button and it would open a folder with my pdf files. Then I would chose the file I need and it would create the hyperlink in the active cell named after my chosen documents name.
Such macro would save me a lot of clicks :)) Thank you for Your help.
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,871
Office Version
  1. 365
Platform
  1. Windows
Welcome to the forum
This allows you to browse to a PDF and create a link in the active cell
VBA Code:
Sub InsertLink()
    Dim cel As Range, Addr As String, Disp As String, pdfPath As String
    pdfPath = "H:\Scan\pdf"
    Set cel = ActiveCell
    Addr = GetPDF(pdfPath)
    Disp = Replace(Replace(Addr, pdfPath & "\", ""), ".pdf", "")
    cel.Parent.Hyperlinks.Add Anchor:=cel, Address:=Addr, TextToDisplay:=Disp
End Sub

Private Function GetPDF(pdfPath As String) As String
  With Application.FileDialog(msoFileDialogOpen)
    .ButtonName = "Create Link"
    .initialFilename = pdfPath
    .Filters.Clear
    .Filters.Add "PDF (*.pdf)", "*.pdf", 1
    .Title = "Select PDF to link"
    .AllowMultiSelect = False
    If .Show = -1 Then GetPDF = .SelectedItems(1)
  End With
End Function

Additionally, if this code is placed in the SHEET code window (not a module like Module1), double clicking anywhere in column A triggers the code
(right click on sheet tab\ View Code \ paste the code below into that window)
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then
        Cancel = True
        Call InsertLink
    End If
End Sub
 

imega

New Member
Joined
Jul 14, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Thank so much, this exactly what i wanted :love:
 

Watch MrExcel Video

Forum statistics

Threads
1,113,776
Messages
5,544,160
Members
410,595
Latest member
Tatum2020
Top