Add Path and Filename Hyperlink

[Divinedar]

I have the following code that hyperlinks the file to a cell in excel when you type in the file name. I need to alter this code and not sure how. I need for the code that when you type in file name it also finds the filename path and filename and hyperlink in the cell.

This is the code:

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 = 16 Then 
MakeHyperLink Target, "C:\Users\darlene.sippio\Documents\Temp" 
End If 
End Sub 

Public Function MakeHyperLink(InRange As Range, _ 
ToFolder As String, _ 
Optional InSheet As Worksheet, _ 
Optional WithExt As String = "pdf") As String 
Dim rng As Range 
Dim Filename As String 
Dim Ext As String 

'Set InRange = Range("Q3").SpecialCells(xlCellTypeLastC ell) 
'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 

For instance; if you have Y:\0000_CCB_MINUTS\2011\CCB_1135.pdf, if you type CCB_1135, the cell would hyperlink as "Y:\0000_CCB_MINUTS\2011\CCB_1135.pdf". So in a way it's searching the folder Y:\0000_CCB_MINUTS\ and it's subfolders, find the file name then hyperlink to that file within the subfolder.

Not sure if this could be done, but if that file is moved the hyperlink is redirected to that file. Is that possible also?

I'm working on it but need some help and clarification.

[tinstaafl]

So in a way it's searching the folder Y:\0000_CCB_MINUTS\ and it's subfolders, find the file name then hyperlink to that file within the subfolder.

Here's a little function that will take the filename and the root folder and find the file and return the full path of the file including the filename.

    Public Function GetFullPath(ByVal Filename As String, ByVal RootFolder As String) As String
        GetFullPath = Directory.GetFiles(RootFolder, Filename, SearchOption.AllDirectories)(0)
    End Function

I know it's only one command, but having it in a function like this makes your code less cluttered. call it like this GetFullPath(File Name, Root Folder)
Once you have this string your MakeHyperLinkfunction can parse it to make a hyperlink.

Not sure if this could be done, but if that file is moved the hyperlink is redirected to that file. Is that possible also?

I'm working on it but need some help and clarification.

I'm not 100% sure but it sounds like you'd have to set up a File System Watcher
If you have more questions about that it would probably be worth it to start a new post, as that will be a whole new discussion.

Hope all this helps

[Divinedar_1]

Sorry it took me so long to reply but been on vacation. Please still need help. Don't understand how to link the MakeHyperLinkfunction to GetFullPath(File Name, Root Folder). How does GetFullPath(File Name, Root Folder) call MakeHyperLinkfunction?

I don't think FileSystemWatcher is what I'm looking for. I just want to be able to type PART of the filename in column A, the code would check the code directory (in subdirectories also) and make a hyperlink to that find in column B.

[tinstaafl]

Instead of this:

    'Set InRange = Range("Q3").SpecialCells(xlCellTypeLastC ell)
    'check to see if folder has trailing \
    If Right(ToFolder, 1) <> "\" Then
    Filename = ToFolder & "\"
    Else
    Filename = ToFolder
    End If

and this:

InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
Filename & rng.Text & WithExt, TextToDisplay:=rng.Text 

Use this:

        InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
        GetFullPath(rng.text & WithExt,ToFolder), TextToDisplay:=rng.Text 

        Public Function GetFullPath(ByVal Filename As String, ByVal RootFolder As String) As String
            GetFullPath = Directory.GetFiles(RootFolder, Filename, SearchOption.AllDirectories)(0)
        End Function

Just a note about this function, it doesn't check if the file isn't found. You could end up with a hyperlink to nothing, but if the file is there it will return the path of the first occurence of the file.

[Divinedar]

Ok question. When I use this:
GetFullPath = Directory.GetFiles(RootFolder, Filename, SearchOption.AllDirectories)(0)
how do I make "Filename" search for a wildcard within the directory, which also has subdirectories. For instance, the file is like CCB_001_Minutes or CCB_002_Minutes, etc.... also there are different extensions, more pdf and doc documents. So if in column A I type 002 I want in column S to hyperlink to the file using the file name as above.

[tinstaafl]

Filename in that function is actually a SearhPattern you can use standard wildcard symbols(*,?) in the string. The function as it sits will return the first filepath that it finds. If you want more flexibility and return more than one filepath some changes need to be made:

        Public Function GetFullPath(ByVal Filename As String, ByVal RootFolder As String) As String()
            GetFullPath = Directory.GetFiles(RootFolder, Filename, SearchOption.AllDirectories)
        End Function

Then to add the links something like this might work:

        For Each Pth as String in GetFullPath(rng.text & WithExt,ToFolder)
        InSheet.Hyperlinks.Add Anchor:=rng, Address:= _Pth
, TextToDisplay:=rng.Text       
        Next

[Divinedar]

Sorry another question:

Say I wanted to use the text in column A as a search for the GetFullPath, do I have to verify that in anyway in the code to search for the string in column A?

[tinstaafl]

Basically pass it into a structure first, then check how many members the structure receives. GetFullPath will return with 0 members if the search fails.

    Dim SearchRsult As List(Of String) = GetFullPath(rng.text & WithExt,ToFolder).ToList
    If Not(SearchResult = 0) Then
        For Each Pth as String in SearchResult
            InSheet.Hyperlinks.Add Anchor:=rng, Address:= _Pth
            , TextToDisplay:=rng.Text
        Next
    End If      

[Divinedar]

Okay now I have the following that may seem to work. I'm having a reference issue I believe that's keeping it from working. Can you help? I'm trying to search subfolders within the directory with this filename wildcard FR.doc.

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

    Dim objFSO As FileSystemObject
    Dim FileCnt As Long

     'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

'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:= _
        RecursiveFolder(objFSO, "Z:\", True, FileCnt), TextToDisplay:=rng.Text
End If

Next

End Function

Sub RecursiveFolder( _
    FSO As FileSystemObject, _
    MyPath As String, _
    IncludeSubFolders As Boolean, _
    Cnt As Long)

     'Declare the variables
    Dim File As File
    Dim Folder As Folder
    Dim SubFolder As Folder


     'Get the folder
    Set Folder = FSO.GetFolder(MyPath)

     'Loop through each file in the folder
    For Each File In Folder.Files
        If File.Name Like "*FR*.doc" Then
            Cnt = Cnt + 1
        End If
    Next File

     'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each SubFolder In Folder.SubFolders
            Call RecursiveFolder(FSO, SubFolder.Path, True, Cnt)
        Next SubFolder
    End If

End Sub

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\Operations_Testing"
End If
End Sub

'This is the entire code that I'm working with.

[tinstaafl]

It looks like your trying to use a sub as a function. What exactly are you trying to do in RecursiveFolder? It looks like you're trying to get a count of the number of '.doc' files with 'FR' in the file name.

[Divinedar]

Okay NO that's not what I need. What I need to do is when I type the file name in a cell, i.e., "FR 2011", it searches for the file in a directory and in subfolders for the file name and hyperlink to that file as the name is typed in. Without the Recursive code it works fine but it doesn't search the subfolders and I need it to search the subfolders.

[Divinedar]

How about this would this work:

Public Function SeparatePathAndFile(ByRef io_strFolderPath As String, ByRef o_strFileName As String)
    Dim strPath() As String
    Dim lngIndex As Long

    o_strFileName = "*FR*.doc"

    strPath() = Split(io_strFolderPath, "\")  'Put the Parts of our path into an array
    lngIndex = UBound(strPath)
    o_strFileName = strPath(lngIndex)   'Get the File Name from our array
    strPath(lngIndex) = ""              'Remove the File Name from our array
    io_strFolderPath = Join(strPath, "\")     'Rebuild our path from our array
End Function

This seems to work somewhat, just can't get it to do the filename.

[tinstaafl]

try this for the filename, o_strFileName = strPath(strPath.Length-1).

What I need to do is when I type the file name in a cell, i.e., "FR 2011", it searches for the file in a directory and in subfolders for the file name and hyperlink to that file as the name is typed in

doesn't the function I gave you work?

[Divinedar]

Click Here

I'm also trying to get help from the aforementioned website. I just can't seem to get this right and I need help as soon as possible.

Please read the above link and see if anyone can help me please.

[tinstaafl]

I'm so sorry, I'm beginning to understand a little better now. Are you using VBA(VB inside Excel)? If so can you put up a screen shot of the worksheet. I think some of the code I gave you was wrong for VBA. In regards to the last code you put up, try this o_strFileName = strPath(lngIndex-1) Then index is 0 based so the last element will always be 1 less than the number of elements.

Also what version of Office are you coding for? I have 2003 and it has a FileSearch object which will do what you want.

[Divinedar]

I think my problem is I don't know where to put o_strFileName = strPath(lngIndex-1), not sure I understand. I have 2010 Excel and FileSearch doesn't work.

This is the first one I'm working on:

This is another of the illustrations:

Let me know if you need anything else that may help.

[tinstaafl]

I think my problem is I don't know where to put o_strFileName = strPath(lngIndex-1)

it should be fine where it is it just needs the '-1' put in.

I have 2010 Excel and FileSearch doesn't work.

How are you trying to access FileSearch? it is part of Office 2010. It will simplify your code tremendously.

[Divinedar]

If it's fine where it is how do I use it in my code? Also, no Application.FileSearch does not work in 2010. I think it said that you would have to Dir().

[tinstaafl]

I got office 2010 installed and worked on some code for you. First off in the vba menu bar go to Tools and choose References. Look for Microsoft Scripting Runtime and make sure it's checked, then click OK. This will allow Intellisense to see the properties and methods of the FileSystemObject making it much easier to work with. Here's the code I came up with:

in Sheet1

'This starts the search routine
Private Sub Worksheet_Change(ByVal Target As Range)
    'Change this to the column where the input is coming from
    If Target.Column = 1 Then
        Set TargetCell = Target
        MakeHyperlinks
    End If
End Sub

In Module1

'Global variables
Public SearchFolder As String
Public fs As New FileSystemObject
Public f As Folder
Public Hyprlinks As Range
Public AllFiles As files
Public fil As File
Public TargetCell As Range
Public Counter As Integer

Sub MakeHyperlinks()
    'Root folder for searching, set it to what you need
    SearchFolder = "c:\Test2"
    Counter = 1
    'Change the "B" to match the column you want the hyperlinks to go into
    Set Hyprlinks = Columns("B")
    Set TopFolder = fs.GetFolder(SearchFolder)
    'Start the recursive search
    Call SearchSubFolders(TopFolder)
End Sub
Sub SearchSubFolders(ByVal f1 As Folder)
    Dim Subs As Folders
    'Search all the files in this folder
    Call AddHyperlinks(f1)
    Set Subs = f1.SubFolders
    For Each flder In Subs
        'For each subfolder call this routine again
        Call SearchSubFolders(flder)
    Next
End Sub    
Sub AddHyperlinks(ByVal f2 As Folder)
    For Each fil In f2.files
    'If the string matches add the hyperlink
    If InStr(1, fil.Name, TargetCell.Text) > 0 Then
       Worksheets(1).Hyperlinks.Add Anchor:=Hyprlinks.Cells(Counter), Address:=fil.Path
       'Increment to the next cell
       Counter = Counter + 1
    End If
    Next
End Sub

[Divinedar]

It works but it hyperlinks to the first cell of the column only, it doesn't find the cell that I'm typing the filename in. So I'm guessing this line InStr(1, fil.Name, TargetCell.Text), which is only row 1, so how do I get it to count to the row and cell that I'm typing in?