Microsoft Access: VBA Programming Code

Provided by Allen Browne, January 2008


Hyperlinks: warnings, special characters, errors

The GoHyperlink() function (below) performs the same task as FollowHyperlink(), with improved control over the outcome. Like FollowHyperlink, you can use it to:

Why a replacement?

FollowHyperlink can be frustrating:

  1. Security warnings may block you, or warn you not to open the file (depending on file type, location, Windows version, permissions, and policies.)
  2. Files fail to open if their names contains some characters (such as # or %.)
  3. Errors are generated if a link fails to open, so any routine that calls it must have similar error handling.

GoHyperlink addresses those frustrations:

  1. It prepends "file:///" to avoid the most common security warnings.
  2. It handles special characters more intelligently.
  3. Errors are handled within the routine. Check the return value if you want to know if the link opened.

It cannot solve these issues completely:

  1. If your network administrator will not allow hyperlinks to open at all, they will not open.
  2. If a file name contains two # characters, it will be understood as a hyperlink. Similarly, if a file name contains the % character followed by two valid hexadecimal digits (e.g. Studetn%50.txt), it will be be interpreted as a pre-escaped character rather than three literal characters.

These are limitations relating to HTML. But you will experience these issues far less frequently than with FollowHyperlink, which fowls up whenever it finds one of these sequences.

Using GoHyperlink()

To use GoHyperlink() in your database:

  1. Create a new stand-alone module in your database. Open the code window (Ctrl+G), and the New Module button Module icon on the toolbar (2nd from left on Standard toolbar.)
  2. Paste in the code below.
  3. To verify Access understands it, choose Compile on the Debug menu.
  4. Save the module, with a name such as ajbHyperlink.

You can now use GoHyperlink() anywhere in your database.

For example if you have a form with a hyperlink field named MyHyperlink, use:
    Call GoHyperlink(Me.[MyHyperlink])

To open a file, be sure you pass in the full path. If necessary, use:
    Call GoHyperlink(CurDir & "\MyDoc.doc")

The PrepareHyperlink() function can also be used to massage a file name so it will be handled correctly as a hyperlink.

The code


Option Compare Database
Option Explicit
'Purpose:   Avoid warning and error messages when opening files with FollowHyperlink
'Author:    Allen Browne (allen@allenbrowne.com)
'Release:   28 January 2008
'Usage:     To open MyFile.doc in Word, use:
'               GoHyperlink "MyFile.doc"
'           instead of:
'               FollowHyperlink "MyFile.doc"
'Rationale:
'FollowHyperlink has several problems:
'   a) It errors if a file name contains characters such as #, %, or &.
'   b) It can give unwanted warnings, e.g. on a fileame with "file:///" prefix.
'   c) It yields errors if the link did not open.
'This replacement:
'   a) escapes the problem characters
'   b) prepends the prefix
'   c) returns True if the link opened (with an optional error message if you care.)
'Limitations:
'   - If a file name contains two # characters, it is treated as a hyperlink.
'   - If a file name contains % followed by 2 hex digits, it assumes it is pre-escaped.
'   - File name must include path.
'Documentation:   http://allenbrowne.com/func-GoHyperlink.html

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

HomeIndex of tipsTop