Hyperlink on form behaving oddly

[DeRochier]

I have a hyperlink on a form that is producing the following error when clicked on:

"Unable to open

https://site....

Cannot download the information you requested."

This seems to have occur after I edit the display text for the hyperlink, even though the URL address is valid and works if I cut and paste it into a browser.

Why am I getting a "Cannot download" error?

 

[misscrf]

Do you have any code on where the hyperlink is? It would help if you could post that. Is that hyperlink on a label, in a text box, or something else? Is there on-click or on-enter code for the control?
I found this code online, and it works very well. I put it in a separate module,(which I call modHyper) so it's separate from other public functions I write.

Option Compare Database

Public Function GoHyperlink(FullFilenameOrLink As Variant) As Boolean
On Error GoTo Err_Handler
    'Purpose:   Replacement for FollowHyperlink.
    'Return:    True if the hyperlink opened.
    'Argument:  varIn = the link to open
    Dim strLink As String
    Dim strErrMsg As String
    
    'Skip error, null, or zero-length string.
    If Not IsError(FullFilenameOrLink) Then
        If FullFilenameOrLink <> vbNullString Then
            strLink = PrepHyperlink(FullFilenameOrLink, strErrMsg)
            If strLink <> vbNullString Then
                FollowHyperlink strLink
                'Return True if we got here without error.
                GoHyperlink = True
            End If
            'Display any error message from preparing the link.
            If strErrMsg <> vbNullString Then
                MsgBox strErrMsg, vbExclamation, "PrepHyperlink()"
            End If
        End If
    End If
    
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "GoHyperlink()"
    Resume Exit_Handler
End Function
Public Function PrepHyperlink(varIn As Variant, Optional strErrMsg As String) As Variant
On Error GoTo Err_Handler
    'Purpose:   Avoid errors and warnings when opening hyperlinks.
    'Return:    The massaged link/file name.
    'Arguments: varIn     = the link/file name to massage.
    '           strErrMsg = string to append error messages to.
    'Note:      Called by GoHyperlink() above.
    '           Can also be called directly, to prepare hyperlinks.
    Dim strAddress As String        'File name or address
    Dim strDisplay As String        'Display part of hyperlink (if provided)
    Dim strTail As String           'Any remainding part of hyperlink after address
    Dim lngPos1 As Long             'Position of character in string (and next)
    Dim lngPos2 As Long
    Dim bIsHyperlink As Boolean     'Flag if input is a hyperlink (not just a file name.)
    Const strcDelimiter = "#"       'Delimiter character within hyperlinks.
    Const strcEscChar = "%"         'Escape character for hyperlinks.
    Const strcPrefix As String = "file:///" 'Hyperlink type if not supplied.
    
    If Not IsError(varIn) Then
        strAddress = Nz(varIn, vbNullString)
    End If
    
    If strAddress <> vbNullString Then
        'Treat as a hyperlink if there are two or more # characters (other than together, or at the end.)
        lngPos1 = InStr(strAddress, strcDelimiter)
        If (lngPos1 > 0&) And (lngPos1 < Len(strAddress) - 2&) Then
            lngPos2 = InStr(lngPos1 + 1&, strAddress, strcDelimiter)
        End If
        If lngPos2 > lngPos1 + 1& Then
            bIsHyperlink = True
            strTail = mid$(strAddress, lngPos2 + 1&)
            strDisplay = Left$(strAddress, lngPos1 - 1&)
            strAddress = mid$(strAddress, lngPos1 + 1&, lngPos2 - lngPos1)
        End If
        
        'Replace any % that is not immediately followed by 2 hex digits (in both display and address.)
        strAddress = EscChar(strAddress, strcEscChar)
        strDisplay = EscChar(strDisplay, strcEscChar)
        'Replace special characters with percent sign and hex value (address only.)
        strAddress = EscHex(strAddress, strcEscChar, "&", """", " ", "#", "<", ">", "|", "*", "?")
        'Replace backslash with forward slash (address only.)
        strAddress = Replace(strAddress, "\", "/")
        'Add prefix if address doesn't have one.
        If Not ((varIn Like "*://*") Or (varIn Like "mailto:*")) Then
            strAddress = strcPrefix & strAddress
        End If
    End If
    
    'Assign return value.
    If strAddress <> vbNullString Then
        If bIsHyperlink Then
            PrepHyperlink = strDisplay & strcDelimiter & strAddress & strcDelimiter & strTail
        Else
            PrepHyperlink = strAddress
        End If
    Else
        PrepHyperlink = Null
    End If
    
Exit_Handler:
    Exit Function
    
Err_Handler:
    strErrMsg = strErrMsg & "Error " & Err.Number & ": " & Err.Description & vbCrLf
    Resume Exit_Handler
End Function

Private Function EscChar(ByVal strIn As String, strEscChar As String) As String
    'Purpose:   If the escape character is found in the string,
    '               escape it (unless it is followed by 2 hex digits.)
    'Return:    Fixed up string.
    'Arguments: strIn      = the string to fix up
    '           strEscChar = the single character used for escape sequqnces. (% for hyperlinks.)
    Dim strOut As String            'output string.
    Dim strChar As String           'character being considered.
    Dim strTestHex As String        '4-character string of the form &HFF.
    Dim lngLen As Long             'Length of input string.
    Dim i As Long                   'Loop controller
    Dim bReplace As Boolean         'Flag to replace character.
    
    lngLen = Len(strIn)
    If (lngLen > 0&) And (Len(strEscChar) = 1&) Then
        For i = 1& To lngLen
            bReplace = False
            strChar = mid(strIn, i, 1&)
            If strChar = strEscChar Then
                strTestHex = "&H" & mid(strIn, i + 1&, 2&)
                If Len(strTestHex) = 4& Then
                    If Not IsNumeric(strTestHex) Then
                        bReplace = True
                    End If
                End If
            End If
            If bReplace Then
                strOut = strOut & strEscChar & Hex(Asc(strEscChar))
            Else
                strOut = strOut & strChar
            End If
        Next
    End If
    
    If strOut <> vbNullString Then
        EscChar = strOut
    ElseIf lngLen > 0& Then
        EscChar = strIn
    End If
End Function

Private Function EscHex(ByVal strIn As String, strEscChar As String, ParamArray varChars()) As String
    'Purpose:   Replace any characters from the array with the escape character and their hex value.
    'Return:    Fixed up string.
    'Arguments: strIn      = string to fix up.
    '           strEscChar = the single character used for escape sequqnces. (% for hyperlinks.)
    '           varChars() = an array of single-character strings to replace.
    Dim i As Long       'Loop controller

    If (strIn <> vbNullString) And IsArray(varChars) Then
        For i = LBound(varChars) To UBound(varChars)
            strIn = Replace(strIn, varChars(i), strEscChar & Hex(Asc(varChars(i))))
        Next
    End If
    EscHex = strIn
End Function

Then I have click code as follows:

Private Sub txtMYLink_Click()
    Dim myLink As String
    myLink = "[URL unfurl="true"]http://"[/URL] & Me.lstListboxWithSomeValue.Column(1) & "/" & Me.AnotherControlValue & "/fixedtext"
    Call GoHyperlink(myLink)
End Sub

Hope this helps make your life easier!


misscrf

It is never too late to become what you could have been ~ George Eliot