Hyperlink file based on cell text

[divinedar095]

I need to hyperlink a file to a cell based on partial filename in a cell. What I would like to do is type partial filename in the cell B2, i.e., 1324 or 1562, and as I type partial filename and hit "enter", it will search the directory and sub-directories for that number, and hyperlink to the file it finds with that number, i.e., CCB_1324, in cell C2. Is this possible? :think:

I am pretty fluent in VB so if someone can just get me started I'm pretty sure I can finish. :banghead:

[omp001]

Hello. Here a simple one if you want to play around with.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub
Dim xlsFile As String, strPath As String
strPath = "C:\MyFolder\"
xlsFile = Dir(strPath & "*.xls")
[C2].ClearContents
Do While xlsFile <> ""
If InStr(xlsFile, [B2]) Then
ActiveSheet.Hyperlinks.Add Anchor:=[C2], Address:= _
strPath & xlsFile, TextToDisplay:=xlsFile
End If
xlsFile = Dir()
Loop
End Sub

[divinedar095]

I see how that works but my problem is getting it to check subdirectories. How do I get it to check subdirectories also? Also wanted to know does this include the entire column B and column C, not just row 2? One more thing I'm noticing that I can get it to link, but it's not recognizing the server. The files are on a server which seems to make a difference.

[omp001]

...I am pretty fluent in VB so if someone can just get me started I'm pretty sure I can finish.
Please, take a look at this:

Search directory and sub folders for Excel files

(http://www.vbaexpress.com/kb/getarticle.php?kb_id=800)

[divinedar095]

I'm using 2010 and it doesn't support Application.FileSearch.

[Kenneth Hobs]

What is the file extension or is it by a file type that it should match?

[divinedar095]

the file types are different, some .doc and some .pdf. The filenames are similar, i.e., CCB_*, the * is number 1232, 3498, etc...

I need to be able to search subdirectories. I type the number in a cell, i.e., 1232 or 3498 and then it hyperlinks to the file, i.e., CCB_1232, CCB_3498.
So if I type 1232 in a cell then in another cell the file is hyperlinked with the filename, CCB_1232.

[Kenneth Hobs]

I guess you would want the first basename match to be linked?

IF I had ken.xlsm and ken.pdf, that is quite a difference in what they might be by just looking at ken.

After I work up a short example, I will post it.

[divinedar095]

I have the following code that if you type the entire filename in the cell it hyperlinks the file but only from one level of the directory. I need for this to search all sub directories from the top level and hyperlink using the filename. This works just needs to search sub directories.

Public Function MakeHyperLink(InRange As Range, _
ToFolder As String, _
Optional InSheet As Worksheet, _
Optional WithExt As String = "doc") As String
Dim rng As Range
Dim Filename As String
Dim Ext As String
'check to see if folder has trailing \
If Right(ToFolder, 1) <> "\" Then
Filename = ToFolder & "\"
Else
Filename = ToFolder
End If
'check to see if need ext
If WithExt <> "" Then
'check to see if ext has leading dot
If Left(WithExt, 1) <> "." Then
WithExt = "." & WithExt
End If
End If
'if not explicit sheet then assign active
If InSheet Is Nothing Then
Set InSheet = ActiveSheet
End If
'now for every cell in range
For Each rng In InRange
'does range have value
If rng <> "" Then
'make hyperlink to file
InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
Filename & rng.Text & WithExt, TextToDisplay:=rng.Text
End If
Next
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
'change "c:\tmp\" to whatever reference you need
'a cell, a public variable, a fixed string
If Target.Column = 7 Then
MakeHyperLink Target, "Z:\Personel\Test Department"
End If
End Sub


So I need for the code above to search sub directories when I type the entire filename in column 7.:bug:

Next in a different code for a different project, I need for this code to hyperlink to the file searching through sub directories but the difference is that I would type partial of the file, i.e., 1232 or 1342, in a cell and in another cell the file will hyperlink to the file it finds with that partial number in it, i.e., CCB_1232 or CCB_1342.

I figured I could at least try and kill two birds with one stone with a little modification of the same code.:bow:

[Kenneth Hobs]

I don't have time right now to work out the clearing of the hyperlink if the changed cell is empty. Obviously, you would change this string to suit.

x:\test\test-

In a Module:
Function FirstFile(matchPath As String) As String
Dim s As String, a() As String
' /b = bare file listing, /s = search subfolders, /c = open command shell, run command and then close shell.
' /a:-d means list files only and not subfolders
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & matchPath & " /a:-d /b /s").StdOut.ReadAll
a() = Split(s, vbCrLf)
If UBound(a) > -1 Then FirstFile = a(0)
End Function

Function GetBaseName(filespec As String)
Dim fso As Object, s As String
Set fso = CreateObject("Scripting.FileSystemObject")
s = fso.GetBaseName(filespec)
Set fso = Nothing
GetBaseName = s
End Function

Right click the sheet's tab, View Code, and paste:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range, ir As Range, f As String
Set r = Range("B2", Range("B" & Rows.Count).End(xlUp))
Set ir = Intersect(Target, r)
If ir Is Nothing Then Exit Sub
For Each c In ir
f = FirstFile("x:\test\test-" & c.Value2 & "*")
'Debug.Print f
With c.Offset(0, 1)
.Clear
.Hyperlinks.Delete
If f <> "" And Not (IsEmpty(c)) Then .Hyperlinks.Add c.Offset(0, 1), f, TextToDisplay:=GetBaseName(f)
End With
Next c
End Sub