• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 541
  • Last Modified:

Excel 2010 UDF to insert hyperlink only if a file exists

Hi,

I have a requirement to insert hyperlinks to .jpg files located in a particular folder on my hard drive, but I only want the hyperlink to be inserted if the file exists. The hyperlinks are to be inserted into several hundred row of a particular column, and each image name is unique.

After searching the internet for some time, the best solution I have found is to create a UDF function that accepts the filename and path as and argument and returns TRUE if the file exists or FALSE if it does not.

This UDF is:

Private Function FileExists(fname) As Boolean
'   Returns TRUE if the file exists
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True _
        Else FileExists = False
End Function

Open in new window


I then simply called the function and insert a link to the image if it exists:

IF(fileexists(C:\path\image x.jpg),(HYPERLINK(C:\path\image x.jpg)),"")

Open in new window


OK so this sort of works if I enter the formula into each cell, but I need to copy this formula down hundreds of rows of a single column, and when I do this the formula won't seem to run on each row, even if the file exists.

I've done some searching on this problem too, and it people have been suggesting inserting Application.Volatile at the beginning of the function, but I'm reluctant to do this unless its really required.

Does anyone have any suggestions to resolve my refresh issue with this UDF, or does anyone have another solution to my requirement?

Hopefully I've included all of the key information.

Many thanks,

stokenator
0
stokenator
Asked:
stokenator
  • 4
  • 2
1 Solution
 
SiddharthRoutCommented:
May I see a sample file? Just five rows of info will do so that I get my references correct.

Sid
0
 
SiddharthRoutCommented:
Since I had some free time I created a sample for you. Please replace the file names in Col A and then run the sub InsertHyperlinks() in module 1.

Sid

Code Used

Sub InsertHyperlinks()
    Dim i As Long, LastRow As Long
    Dim StrTemp As String
    
    LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 1 To LastRow
        If FileExists(Sheets("Sheet1").Range("A" & i).Value) Then
            StrTemp = Sheets("Sheet1").Range("A" & i).Value
            Sheets("Sheet1").Hyperlinks.Add Anchor:=Range("A" & i), Address:=StrTemp, _
            TextToDisplay:=StrTemp
        End If
    Next i
End Sub

Private Function FileExists(fname) As Boolean
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True
End Function

Open in new window

Inserting-Hyperlinks.xls
0
 
stokenatorAuthor Commented:
Hi Sid,

Thanks for the quick response and for your help. Your solution works as describes but I'm having trouble adapting it to my needs, and I think its because I was not clear in my original post.

I actually have several columns where I need to do the same. I apologise for not mentioning this, but I was anticipating a formula that calls the FileExists UDF, therefore I thought I could use this formula where I needed it. To avoid an further confusion I have created an attached a file that (hopefully) clearly states what I need to do.

Essentially look for the file specified in columns G-J, and if they exist, paste hyperlinks to them in columns A-D, if not leave the cells blank.

Is it possible to have this function run each time the workbook is opened? I noticed with your function once the hyperlink is inserted, and I delete the file and rerun the code, the hyperlink remains.

Many thanks in advance,

stokenator


my-insert-hyperlink-sample-file.xlsx
0
Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

 
SiddharthRoutCommented:
Is this what you want?

I have attached 2 samples.

1) Manual. So that you can manually test it
2) Auto: Which will run automatically when you open the workbook.

Sid

1)
Code Used for manual in a module

Sub InsertHyperlinks()
    Dim i As Long, j As Long, LastRow As Long
    Dim StrTemp As String
    
    LastRow = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row
    lastcol = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

    For i = 2 To LastRow
        For j = 7 To lastcol
            StrTemp = Sheets("Sheet1").Cells(i, j).Value
            If FileExists(StrTemp) Then
                Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Cells(i, j - 6), Address:=StrTemp, _
                TextToDisplay:=StrTemp
            Else
                Sheets("Sheet1").Cells(i, j - 6).ClearContents
            End If
        Next j
    Next i
End Sub

Public Function FileExists(fname) As Boolean
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True
End Function

Open in new window


2)
Code Used for Auto In Workbook Open Event

Private Sub Workbook_Open()
    Dim i As Long, j As Long, LastRow As Long
    Dim StrTemp As String
    
    LastRow = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row
    lastcol = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

    For i = 2 To LastRow
        For j = 7 To lastcol
            StrTemp = Sheets("Sheet1").Cells(i, j).Value
            If FileExists(StrTemp) Then
                Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Cells(i, j - 6), Address:=StrTemp, _
                TextToDisplay:=StrTemp
            Else
                Sheets("Sheet1").Cells(i, j - 6).ClearContents
            End If
        Next j
    Next i
End Sub

Open in new window


Code Used for Auto In Module

Public Function FileExists(fname) As Boolean
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True
End Function

Open in new window

my-insert-hyperlink-sample-file-.xlsm
my-insert-hyperlink-sample-file-.xlsm
0
 
SiddharthRoutCommented:
BTW I forget to dim lastcol

Please Add

Dim lastcol as Long to the above code.

Sid
0
 
stokenatorAuthor Commented:
Thanks very much Sid, that works great
0

Featured Post

Learn to develop an Android App

Want to increase your earning potential in 2018? Pad your resume with app building experience. Learn how with this hands-on course.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now