Try the following code which contains installation instructions. The data 'EF303' must be previously entered in a cell. Make the cell containing 'EF303' the active cell. Enter 'ALT' Q, and a hyperlink will be created if there is ONLY one file that starts with 'EF303'. If there are NO MATCHES, or TWO OR MORE MATCHES, a message will be displayed.
Option Explicit
'This was created and tested in Excel 2003.
'
'Put the code 'call ENABLE_ALT_Q_WORKBOOK_EVENTS' in 'Private Sub Workbook_Open()'
'located in 'ThisWorkbook' in the Visual Basic Editor (VBE).
'To access the VBE from Excel, press 'ALT' F11, then
'press 'CTL' R to obtain the 'Project Explorer' tree.
'The following code can go in any VBAProject module in the Workbook.
Sub ENABLE_ALT_Q_WORKBOOK_EVENTS()
'q MUST be 'lower case'
Application.OnKey "%q", "ALT_Q_EVENT_HANDLER"
End Sub
Sub ALT_Q_EVENT_HANDLER()
Dim iMatchingFileCount As Integer
Dim sCell As String
Dim sFoundFile As String
Dim sFileName As String
Dim sPath As String
Dim sSearchSpec As String
Dim sToken As String
'MsgBox "ALT_Q_ROUTINE invoked for cell " & ActiveCell.Address
'Get the Path name
sPath = ThisWorkbook.Path & "\"
'Find the 'cell' that was active when 'Alt Q' was invoked
sCell = ActiveCell.Address
'Get the contents of the cell
sToken = Range(sCell).Value
'Create a search specification
sSearchSpec = sPath & sToken & "*"
'Find matching files
sFoundFile = Dir(sSearchSpec)
sFileName = sFoundFile
While sFoundFile <> ""
iMatchingFileCount = iMatchingFileCount + 1
sFoundFile = Dir 'Find the next matching file name
Wend
'Act on the results of the search
Select Case iMatchingFileCount
Case 0
MsgBox "There were no MATCHING FILES starting with '" & sToken & "'"
Case 1
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:=sFileName, _
TextToDisplay:=sToken
Range(sCell).Select
'NOTE: Hyperlink 'font', 'font size' and other font attributes are controlled
' by format > style > hyperlink and apply to the entire workbook.
MsgBox "A Hyperlink was created for '" & sToken & "' to file:" & vbCrLf & _
"'" & sFileName & "'"
Case Else
MsgBox "There were " & iMatchingFileCount & " FILES starting with '" & sToken & "'." & vbCrLf & _
"NO Hyperlink was CREATED."
End Select
End Sub
Bookmarks