' ----------------------------------------------------------------
' Procedure Name: CreateHyperlinks
' Purpose: Add hyperlinks pointing to invoice pdf files for invoice number specified in the cell being processed.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 6/22/2023
' ----------------------------------------------------------------
Sub CreateHyperlinks()
' Path to the folder containing the PDFs.
Dim sPathAndFolderStart As String
' Path to the folder containing the PDFs.
Dim sPathAndFolderFound As String
' Name of the file to open.
Dim sFileName As String
' Header label for the "invoice number" column (INV NO)
Dim sHeader As String
' Used to iterate through the rows requiring a hyperlink.
Dim iRow As Long
' Worksheet containing the invoice number.
Dim wsInvoices As Worksheet
' Cell into which the link is placed.
Dim rAnchorCell As Range
' Header label in the column in the table for invoice number.
sHeader = "INV NO" '<= Change this if the INV NO header label in the worksheet is changed.
' Set worksheet object to point to the worksheet.
Set wsInvoices = Worksheets("Sheet1") '<= Change this if the name of the worksheet changes.
' "Start" folder in which files and subfolders are located.
sPathAndFolderStart = "C:/Users/Jim/Desktop/REPORTS/" '<= Change this to point to the correct folder on your computer.
' Use Find to locate the cell containing the text in string sHeader.
Set rAnchorCell = wsInvoices.Cells.Find(What:=sHeader, _
After:=wsInvoices.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True, _
SearchFormat:=False)
' If the header label was not found then tell user and exit sub.
If rAnchorCell Is Nothing _
Then
MsgBox "The header with the label " & sHeader & Chr(10) & "was not found in worksheet " & wsInvoices.Name, vbInformation
Exit Sub
End If
iRow = 0
' Iterate through invoice numbers and add the hyperlinks in the INV NO column
Do
iRow = iRow + 1
' File name is the value in the anchor cell plus the .pdf extension.
sFileName = rAnchorCell.Offset(iRow) & ".pdf"
' Locate the file in a folder. Puts path into ByRef var named sPathAndFolderFound.
Call FindFile(sPathAndFolderStart, sFileName, sPathAndFolderFound)
sPathAndFolderFound = sPathAndFolderFound & "\"
If rAnchorCell.Offset(iRow) <> "" _
Then
With wsInvoices
.Hyperlinks.Add _
Anchor:=rAnchorCell.Offset(iRow), _
Address:=sPathAndFolderFound & sFileName, _
TextToDisplay:=rAnchorCell.Offset(iRow).Value, _
ScreenTip:="Open invice PDF"
End With
End If
Loop Until rAnchorCell.Offset(iRow + 1) = ""
End Sub
