Search code examples
excelvbaimageuserform

VBA Shorten Hyperlink Image path when submitting to a database from a Userform

I am trying to figure out the best way to shorten my image hyperlink paths when clicking the submit button. Right now, all userform data and image file paths go to their appropriate rows/columns but it's ugly. I want to see how to use VBA to shorten the filepath to either the filename or change the path to an entire different word like "image". Ideally, I would want to replace the hyperlink with the word "image" but I am not sure that is possible?

I found some ideas on this site about creating functions to call that would shorten the path but I wasn't sure how to use those functions when submitting the data to a database.

My current code is below, followed by the function that I found that could work. 

Private Sub CommandButton1_Click()
Dim TargetRow As Long
Dim linked_path1 As Variant
Dim linked_path2 As Variant

TargetRow = Sheets("Engine").Range("B3").Value + 1 'plus 1 move the row down 1 so it doesn't overrite last row value

Sheets("Database").Range("Data_Start").Offset(TargetRow, 1) = orderid
Sheets("Database").Range("Data_Start").Offset(TargetRow, 2) = ComboBox1
Sheets("Database").Range("Data_Start").Offset(TargetRow, 3) = ComboBox2
Sheets("Database").Range("Data_Start").Offset(TargetRow, 4) = ComboBox3
Sheets("Database").Range("Data_Start").Offset(TargetRow, 5) = TextBox2
Sheets("Database").Range("Data_Start").Offset(TargetRow, 6) = TextBox3

'Set named range and a variable in teh Hyperlink.Add function
Set linked_path1 = Sheets("Database").Range("Data_Start").Offset(TargetRow, 7)
Sheets("Database").Hyperlinks.Add Anchor:=linked_path1, _
Address:=filepath1

Set linked_path2 = Sheets("Database").Range("Data_Start").Offset(TargetRow, 8)
Sheets("Database").Hyperlinks.Add Anchor:=linked_path2, _
Address:=filepath2

Unload UserForm2
End Sub

The Function I found on this site that could do it - this only grabs the filename and not the extension

Function FileNameNoExtensionFromPath(strFullPath As String) As String

Dim intStartLoc As Integer
Dim intEndLoc As Integer
Dim intLength As Integer

intStartLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "\") - 1)
intEndLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "."))
intLength = intEndLoc - intStartLoc

FileNameNoExtensionFromPath = Mid(strFullPath, intStartLoc, intLength)

End Function

enter image description here

Thanks so much April

Solution

  • You can just use the TextToDisplay property of hyperlinks.add.

    Private Sub CommandButton1_Click()

    Dim TargetRow As Long
    Dim linked_path1 As Variant
    Dim linked_path2 As Variant

    TargetRow = Sheets("Engine").Range("B3").Value + 1 'plus 1 move the row down 1 so it doesn't overrite last row value

    With Sheets("Database").Range("Data_Start")

        .Offset(TargetRow, 1) = orderid
        .Offset(TargetRow, 2) = ComboBox1
        .Offset(TargetRow, 3) = ComboBox2
        .Offset(TargetRow, 4) = ComboBox3
        .Offset(TargetRow, 5) = TextBox2
        .Offset(TargetRow, 6) = TextBox3

        'Set named range and a variable in teh Hyperlink.Add function
        Set linked_path1 = .Offset(TargetRow, 7)

    End With

    Sheets("Database").Hyperlinks.Add Anchor:=linked_path1, _
            Address:=filepath1, TextToDisplay:=getfilenamefrompath(filepath1)

    Set linked_path2 = Sheets("Database").Range("Data_Start").Offset(TargetRow, 8)
    Sheets("Database").Hyperlinks.Add Anchor:=linked_path2, _
            Address:=filepath2, TextToDisplay:=getfilenamefrompath(filepath2)

    Unload UserForm2

End Sub

    Also, With...End With statements work well for your group of range offsets..

    Ahh, almost forgot - you were still needing to figure out the filename. With being a URL, the Split() function would work. We can just make a similar function to the one you found.

    Function getFileNameFromPath(filePath As String, Optional delim as string = "\") As String

    getFileNameFromPath = Split(filePath, delim)(UBound(Split(filePath, delim)))

End Function

    In this function, you are going to split the filePath by the delim \, twice. The first one is self-explanatory, but the second you are just grabbing the last index of the split using the UBound() function.

    Update: Added the optional argument of delim so it would work with both URLs (using /) and file paths (using \). It will default to \ unless you specify otherwise.