PDA

View Full Version : Hyperlink to Search Folder for a Number



enrique63
11-17-2009, 02:51 PM
In A2:A1000, I have a 6-digit number and in B2:B1000 I want to put a hyperlink that will open a certain folder and search for that 6-digit number, which would allow me to open any and all documents related to that number. Is this possible?

Many thanks,
Enrique

geekgirlau
11-17-2009, 05:35 PM
Is the 6-digit number part of the filename for which you are searching, or part of the file contents?

enrique63
11-17-2009, 06:47 PM
Thanks for your response. The number is the first part of the file name, so it'll probably be necessary to somehow add an * to the number search in the VBA code.

geekgirlau
11-17-2009, 08:23 PM
This doesn't use a hyperlink, but the double-click event. There is a worksheet event for "follow hyperlink", but the code runs after the hyperlink is opened which I don't think will work well for your purposes.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFound() As String
Dim strPath As String
Dim strFile As String
Dim blnFound As Boolean
Dim l As Long


On Error GoTo ErrHandler
' check that the user in the correct area
If Not Intersect(Target, shData.Range("FolderLink")) Is Nothing Then
' check that the folder exists
strPath = Target.Value

If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If

If Dir(strPath, vbDirectory) = "" Then
MsgBox "This folder does not exist:" & vbCrLf & vbCrLf & strPath, vbExclamation, _
"Folder Not Found"
GoTo ExitHere
End If

' capture all the filenames found in the folder
strFile = Dir(strPath & Target.Offset(0, -1).Value & "*.xls", vbNormal)

Do Until strFile = ""
ReDim Preserve strFound(0 To l) As String
strFound(l) = strFile
l = l + 1
blnFound = True

strFile = Dir()
Loop

' check whether any files were found
If blnFound = False Then
MsgBox "No matching files were found", vbInformation, "No Files Found"
Else
' warn the user if there's lots of files
If UBound(strFound) > 10 Then
If vbNo = MsgBox("There were x file found - do you want to continue opening them all?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Multiple Files Found") Then
GoTo ExitHere
End If
End If

' open the files
For l = 0 To UBound(strFound)
Workbooks.Open strPath & strFound(l)
Next l
End If

' don't behave like a normal double-click
Cancel = True
End If


ExitHere:
Exit Sub

ErrHandler:
MsgBox Err.Description, vbCritical, "Unexpected Error (" & Err.Number & ")"
Resume ExitHere
End Sub

enrique63
11-17-2009, 09:01 PM
I copied the code into Sheet1. When I double click, I get the message "Compile Error. Variable not defined" and shData (in BLUE below) is highlighted.

I'm not as familiar with double click events. Would you mind sending it to me as an attachment?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFound() As String
Dim strPath As String
Dim strFile As String
Dim blnFound As Boolean
Dim l As Long


On Error GoTo ErrHandler
' check that the user in the correct area
If Not Intersect(Target, shData.Range("FolderLink")) Is Nothing Then
' check that the folder exists
strPath = Target.Value

Thank you!

geekgirlau
11-17-2009, 09:04 PM
There are a couple of things I didn't point out:

"shData" is the name that I have given the relevant sheet in the VBE window. You can use the example below if you prefer.If Not Intersect(Target, Sheets("MySheetName").Range("MyRangeName")) Is Nothing Then

This code assumes that you have a named range that covers all the cells in column B that are populated.

enrique63
11-17-2009, 10:05 PM
I've attached an example workbook with your recommendations. Column A has the 6-digit number and Column B has the message "DoubleClick to Search for Documents" (which can be replaced with the folder location if the code. The documents I want to search are all in one folder called "Portfolio").

When I put the "DoubleClick..." message, it tell me folder doesn't exist. When I put the folder location (c:\..\Portfolio), it tells me no files found, when something should be found.

Thanks again.

geekgirlau
11-17-2009, 10:24 PM
Okay, from your original post it appeared that the folder was going to be in column B, so this is what the code is expecting. Unless you have a file path called "DoubleClick to Search for Documents", for your first 2 entries the code will tell you that the folder doesn't exist, which is exactly what happens.

I've modified the code to look in a single folder only. It's looking ONLY in the Portfolio folder - no sub-folders, and it's expecting files that START with the number in column A and END in ".xls".


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFound() As String
Dim strFile As String
Dim blnFound As Boolean
Dim l As Long

Const cstrPATH = "C:\Documents and Settings\HP_Administrator\Desktop\Portfolio\"


On Error GoTo ErrHandler
' check that the user in the correct area
If Not Intersect(Target, Sheets("Sheet1").Range("ID")) Is Nothing Then
' check that the folder exists
If Dir(cstrPATH, vbDirectory) = "" Then
MsgBox "This folder does not exist:" & vbCrLf & vbCrLf & cstrPATH, vbExclamation, _
"Folder Not Found"
GoTo ExitHere
End If

' capture all the filenames found in the folder
strFile = Dir(cstrPATH & Target.Value & "*.xls", vbNormal)

Do Until strFile = ""
ReDim Preserve strFound(0 To l) As String
strFound(l) = strFile
l = l + 1
blnFound = True

strFile = Dir()
Loop

' check whether any files were found
If blnFound = False Then
MsgBox "No matching files were found", vbInformation, "No Files Found"
Else
' warn the user if there's lots of files
If UBound(strFound) > 10 Then
If vbNo = MsgBox("There were x file found - do you want to continue opening them all?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Multiple Files Found") Then
GoTo ExitHere
End If
End If

' open the files
For l = 0 To UBound(strFound)
Workbooks.Open cstrPATH & strFound(l)
Next l
End If

' don't behave like a normal double-click
Cancel = True
End If


ExitHere:
Exit Sub

ErrHandler:
MsgBox Err.Description, vbCritical, "Unexpected Error (" & Err.Number & ")"
Resume ExitHere
End Sub

enrique63
11-17-2009, 11:14 PM
You are amazing, this is starting to work!

I'm realizing that automatically opening the files is not a good idea because opening multiple documents will get messy. Is it possible to maybe just open a folder that will display just the search result, and allow me to open the file I want (something like the pic below).

Also, the files are PDF, but it would be nice if it would search for all file types to have more flexibility.

Many, many Thanks!

geekgirlau
11-17-2009, 11:30 PM
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFound() As String
Dim strFile As String
Dim blnFound As Boolean
Dim l As Long

Const cstrPATH = "C:\Documents and Settings\HP_Administrator\Desktop\Portfolio\"


On Error GoTo ErrHandler
' check that the user in the correct area
If Not Intersect(Target, Sheets("Sheet1").Range("ID")) Is Nothing Then
' check that the folder exists
If Dir(cstrPATH, vbDirectory) = "" Then
MsgBox "This folder does not exist:" & vbCrLf & vbCrLf & cstrPATH, vbExclamation, _
"Folder Not Found"
GoTo ExitHere
End If

' capture all the filenames found in the folder
' finds ALL file types
strFile = Dir(cstrPATH & Target.Value & "*.*", vbNormal)

Do Until strFile = ""
ReDim Preserve strFound(0 To l) As String
strFound(l) = strFile
l = l + 1
blnFound = True

strFile = Dir()
Loop

' check whether any files were found
If blnFound = False Then
MsgBox "No matching files were found", vbInformation, "No Files Found"
Else
MsgBox "There were " & UBound(strFound) + 1 & " files found", vbInformation, _
"Matching Files Located"

Shell "Explorer.exe /n,/e," & cstrPATH, vbNormalFocus

'this also works but displays irritating security message in Excel 2007
'ActiveWorkbook.FollowHyperlink Address:=cstrPATH, NewWindow:=True
End If

' don't behave like a normal double-click
Cancel = True
End If


ExitHere:
Exit Sub

ErrHandler:
MsgBox Err.Description, vbCritical, "Unexpected Error (" & Err.Number & ")"
Cancel = True
Resume ExitHere
End Sub

enrique63
11-17-2009, 11:46 PM
Wow! THANK YOU! Is there anything I can do to return the favor?

Cheers!

Enrique

geekgirlau
11-18-2009, 12:03 AM
That's what we're here for! The best thing you can do is pass on your knowledge to others as you gain more experience - there will always be newbies coming along who can benefit from what you've learned along the way. We all started off in the same position! :clever:

enrique63
11-18-2009, 11:24 AM
I'm noticing 2 things I didn't see before:
1) The search is identifying the correct number of files but when it opens the explorer window, it lists all the files and not just the search result for the 6-digit number in Column A (~3000 entries).
2) When I add new ID numbers to Column A, the doubleclick doesn't do anything (even when I close and reopen the workbook). Can this be solved?

Thanks, Enrique

geekgirlau
11-18-2009, 03:50 PM
2) You need to make sure that any new numbers you add are part of the range "ID". If you are just typing numbers at the end of the file, it won't be - insert new rows in the middle.

1) The simple methods (of which this is one) won't allow you to do the kind of custom filter that you're talking about. It can be done using an API call, but I'll warn you now that it's a LOT of code, including a class module. Because the files are not necessarily Excel files, you then need to handle each selected file separately if the user actually wants to open them.

enrique63
11-18-2009, 04:30 PM
Hi Geekgirlau, Thanks for pointing out the need for my numbers to be inside the range.

Unfortunately, there's no point in using the ID range if the doubleclick is only going to open the folder and display ALL the files. I had hoped there was a way to doubleclick the ID number which would open an explorer window that displays (PDF) files with that ID number.

Thanks again for all your help. Let me know if any other solutions come to mind.

geekgirlau
11-18-2009, 05:57 PM
The issue is what do you want to have happen after the files are displayed? So far, this is what I have - it will allow you to open a single file.

Need to create a CLASS MODULE called "clsOpenSave" and paste in the following code:


Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Const cdlAPIcancel = 32755
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' OFN_SHAREWARN = &H0
' OFN_SHARENOWARN = &H1
' OFN_SHAREFALLTHROUGH = &H2
Public Enum OFN_Flags
OFN_READONLY = &H1
OFN_OVERWRITEPROMPT = &H2
OFN_HIDEREADONLY = &H4
OFN_NOCHANGEDIR = &H8
OFN_SHOWHELP = &H10
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFS_MAXPATHNAME = &H80
OFN_NOVALIDATE = &H100
OFN_ALLOWMULTISELECT = &H200
OFN_EXTENSIONDIFFERENT = &H400
OFN_PATHMUSTEXIST = &H800
OFN_FILEMUSTEXIST = &H1000
OFN_CREATEPROMPT = &H2000
OFN_SHAREAWARE = &H4000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NONETWORKBUTTON = &H20000
OFN_NOLONGNAMES = &H40000
OFN_EXPLORER = &H80000
OFN_NODEREFERENCELINKS = &H100000
OFN_LONGNAMES = &H200000
End Enum
'local variable(s) to hold property value(s)
Private mvarCancelError As Boolean 'local copy
Private mvarDefaultExt As String 'local copy
Private mvarDialogTitle As String 'local copy
Private mvarFileName As String 'local copy
Private mvarFileTitle As String 'local copy
Private mvarFilterIndex As Integer 'local copy
Private mvarFilter As String 'local copy
Private mvarFlags As Long 'local copy
Private mvarInitDir As String 'local copy
Private mvarMaxFileSize As Integer 'local copy
Private mvarhWnd As Long 'local copy
Private mvarFileExt As Integer 'local copy
Public Property Let FileExt(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FileExt = 5
mvarFileExt = vData
End Property
Public Property Get FileExt() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FileExt
FileExt = mvarFileExt
End Property
Public Property Let hWnd(ByVal vData As Long)
' The owner of the window
' Default: 0
mvarhWnd = vData
End Property
Public Property Get hWnd() As Long
hWnd = mvarhWnd
End Property
Public Sub ShowSave()
Dim ofn As OPENFILENAME
Dim retval As Long
With ofn
.Flags = Flags
.hwndOwner = hWnd
.hInstance = 0
.lCustData = 0
.lpfnHook = 0
' .lpstrCustomFilter = vbNullChar 'Removed for NT compatibility problems
.lpstrDefExt = DefaultExt
.lpstrFile = FileName & String$(MaxFileSize - Len(FileName) + 1, vbNullChar)
.lpstrFileTitle = FileTitle & Space$(256)
.lpstrFilter = mvarFilter
.lpstrInitialDir = InitDir
.lpstrTitle = DialogTitle
.lpTemplateName = 0
.lStructSize = Len(ofn)
.nFileExtension = 0
.nFileOffset = 0
.nFilterIndex = FilterIndex
.nMaxCustFilter = 0
.nMaxFile = MaxFileSize
.nMaxFileTitle = 260
End With
retval = GetSaveFileName(ofn)
If retval > 0 Then
With ofn
Flags = .Flags
DefaultExt = .lpstrDefExt
FileName = Trim$(.lpstrFile)
FileTitle = Trim$(.lpstrFileTitle)
FileExt = .nFileExtension
mvarFilter = Trim$(.lpstrFilter)
InitDir = Trim$(.lpstrInitialDir)
FilterIndex = Trim$(.nFilterIndex)
End With
Else
If CancelError Then Err.Raise cdlAPIcancel, "Run-time error", "Cancel was selected"
End If
End Sub
Public Sub ShowOpen()
Dim ofn As OPENFILENAME
Dim retval As Long
With ofn
.Flags = Flags
.hwndOwner = hWnd
.hInstance = 0
.lCustData = 0
.lpfnHook = 0
' .lpstrCustomFilter = vbNullChar ' Removed for NT compatibility problem
.lpstrDefExt = DefaultExt
.lpstrFile = FileName & String$(MaxFileSize - Len(FileName) + 1, 0)
.lpstrFileTitle = FileTitle & Space$(256)
.lpstrFilter = mvarFilter
.lpstrInitialDir = InitDir
.lpstrTitle = DialogTitle
.lpTemplateName = 0
.lStructSize = Len(ofn)
.nFileExtension = 0
.nFileOffset = 0
.nFilterIndex = FilterIndex
.nMaxCustFilter = 0
.nMaxFile = MaxFileSize
.nMaxFileTitle = 260
End With
retval = GetOpenFileName(ofn)
If retval > 0 Then
With ofn
Flags = .Flags
DefaultExt = .lpstrDefExt
FileName = Trim$(.lpstrFile)
FileTitle = Trim$(.lpstrFileTitle)
FileExt = .nFileExtension
mvarFilter = Trim$(.lpstrFilter)
InitDir = Trim$(.lpstrInitialDir)
FilterIndex = Trim$(.nFilterIndex)
End With
Else
If CancelError Then Err.Raise 0, "Run-time error", "Cancel was selected"
End If
End Sub
Public Property Let MaxFileSize(ByVal vData As Integer)
' The maximum length of file name returned
' Default: 260
mvarMaxFileSize = vData
End Property
Public Property Get MaxFileSize() As Integer
MaxFileSize = mvarMaxFileSize
End Property
Public Property Let InitDir(ByVal vData As String)
' Directory to open window in
' Default: "C:\"
mvarInitDir = vData
End Property
Public Property Get InitDir() As String
InitDir = mvarInitDir
End Property
Public Property Let Flags(ByVal vData As OFN_Flags)
' Flags specifying properties of dialog box
' Default: 0
mvarFlags = vData
End Property
Public Property Get Flags() As OFN_Flags
Flags = mvarFlags
End Property
Public Property Let Filter(ByVal vData As String)
' Filters that the user can select in drowpdown combo
' Usage: Friendlyname1|*.ex1|Freindlyname2|*.ex2 etc.
' Default: "All Files (*.*)|*.*"
Dim pipepos As String
Do While InStr(vData, "|") > 0
pipepos = InStr(vData, "|")
If pipepos > 0 Then
vData = Left$(vData, pipepos - 1) & vbNullChar & Right$(vData, Len(vData) - pipepos)
End If
Loop
If Right$(vData, 2) <> vbNullChar & vbNullChar Then vData = vData & vbNullChar
If Right$(vData, 2) <> vbNullChar & vbNullChar Then vData = vData & vbNullChar
mvarFilter = vData
End Property
Public Property Get Filter() As String
Dim nullpos As String
Dim tempfilter As String
tempfilter = mvarFilter
Do While InStr(tempfilter, vbNullChar) > 0
nullpos = InStr(tempfilter, vbNullChar)
If nullpos > 0 Then
tempfilter = Left$(tempfilter, nullpos - 1) & vbNullChar & Right$(tempfilter, Len(tempfilter) - nullpos)
End If
Loop
If Right$(tempfilter, 1) = "|" Then tempfilter = Left$(tempfilter, Len(tempfilter) - 1)
If Right$(tempfilter, 1) = "|" Then tempfilter = Left$(tempfilter, Len(tempfilter) - 1)
Filter = tempfilter
End Property
Public Property Let FilterIndex(ByVal vData As Integer)
' Index of filter to select as default
' The first item is 1, second 2, etc.
' Default: 1
mvarFilterIndex = vData
End Property
Public Property Get FilterIndex() As Integer
FilterIndex = mvarFilterIndex
End Property
Public Property Let FileTitle(ByVal vData As String)
' The name of the file without path
mvarFileTitle = vData
End Property
Public Property Get FileTitle() As String
FileTitle = mvarFileTitle
End Property
Public Property Let FileName(ByVal vData As String)
' Name of the file, including path
mvarFileName = vData
End Property
Public Property Get FileName() As String
FileName = mvarFileName
End Property
Public Property Let DialogTitle(ByVal vData As String)
' The name of the dialog box
mvarDialogTitle = vData
End Property
Public Property Get DialogTitle() As String
DialogTitle = mvarDialogTitle
End Property
Public Property Let DefaultExt(ByVal vData As String)
' The default extension added if one is not specified in the name
mvarDefaultExt = vData
End Property
Public Property Get DefaultExt() As String
DefaultExt = mvarDefaultExt
End Property
Public Property Let CancelError(ByVal vData As Boolean)
' Raise an error if user clicks cancel
' Default: False
mvarCancelError = vData
End Property
Public Property Get CancelError() As Boolean
CancelError = mvarCancelError
End Property
Private Sub Class_Initialize()
CancelError = False
DefaultExt = ""
DialogTitle = ""
FileName = ""
FileTitle = ""
Filter = "All Files (*.*)|*.*"
FilterIndex = 1
Flags = 0
InitDir = "C:\"
MaxFileSize = 260
hWnd = 0
End Sub


Then add a NORMAL module and paste in the following:


Option Explicit
Private CommonDialogAPI As New clsOpenSave
Sub OpenFile(strFolder As String, strFilter As String)
CommonDialogAPI.InitDir = strFolder
CommonDialogAPI.Filter = "Custom (" & strFilter & ")|" & strFilter
CommonDialogAPI.CancelError = True
On Error GoTo Cancelled
CommonDialogAPI.ShowOpen


NotCancelled:
ActiveWorkbook.FollowHyperlink CommonDialogAPI.FileName
Cancelled:
End Sub


And finally change your SHEET module to this:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFound() As String
Dim strFile As String
Dim blnFound As Boolean
Dim l As Long

'Const cstrPATH = "C:\Documents and Settings\HP_Administrator\Desktop\Portfolio\"
Const cstrPATH = "C:\InitiativesDB\"

On Error GoTo ErrHandler
' check that the user in the correct area
If Not Intersect(Target, Sheets("Sheet1").Range("ID")) Is Nothing Then
' check that the folder exists
If Dir(cstrPATH, vbDirectory) = "" Then
MsgBox "This folder does not exist:" & vbCrLf & vbCrLf & cstrPATH, vbExclamation, _
"Folder Not Found"
GoTo ExitHere
End If

' capture all the filenames found in the folder
' finds ALL file types
strFile = Dir(cstrPATH & Target.Value & "*.*", vbNormal)

Do Until strFile = ""
ReDim Preserve strFound(0 To l) As String
strFound(l) = strFile
l = l + 1
blnFound = True

strFile = Dir()
Loop

' check whether any files were found
If blnFound = False Then
MsgBox "No matching files were found", vbInformation, "No Files Found"
Else
MsgBox "There were " & UBound(strFound) + 1 & " files found", vbInformation, "Matching Files Located"

OpenFile cstrPATH, Target.Value & "*.*"
End If

' don't behave like a normal double-click
Cancel = True
End If


ExitHere:
Exit Sub

ErrHandler:
MsgBox Err.Description, vbCritical, "Unexpected Error (" & Err.Number & ")"
Cancel = True
Resume ExitHere
End Sub

enrique63
11-19-2009, 12:29 AM
I think you did it! I can't wait to test it some more tomorrow and look at the details of how you did it. I'll get back to you tomorrow!

Thank you!

enrique63
11-19-2009, 03:34 PM
Very nice! After doubleclicking the number, I'm getting the searched file list in an "Open command" window, so upon opening one of the file, the window with the file list closes automatically.

Is it possible to get the searched file list in an explorer window so that when I open a file, I can go back to the explorer window and open another file without having to go back and doubleclick ID number again?

geekgirlau
11-19-2009, 06:26 PM
I don't know of any method to display Windows Explorer with a custom filter.

geekgirlau
11-19-2009, 06:50 PM
Okay, this version will allow you to open multiple files, however it does NOT use Windows Explorer (I don't believe this is possible, although perhaps someone else has another solution) and the dialog box will close after you open the files.

enrique63
11-20-2009, 01:47 PM
Hi, the Multi Select window is an improvement over only being able to open one file at a time. THANKS AGAIN!!

-Enrique