Putting an Hyperlink in a MsgBox !!

Jaafar Tribak · Jun 27, 2021

Hi all,
I have been playing with this little project recently which, as the thread title states, allows for adding an hyperlink to the native vba MsgBox.
At the moment, I managed to make this work with only one hyperlink per MsgBox...

This little "tool"can come as a handy, a quicker and a more compact alternative to using a userform and then formatting & coding a Label control so it looks and behaves like a real hyperlink.

Example workbook:
HyperlinkMsgBox.xls

Easy to use logic :

VBA Code:

Function HyperlinkMsgBox( _
        ByVal PROMPT As String, _
        ByVal HyperlinkText As String, _
        ByVal HyperlinkTarget As String, _
        Optional ByVal BUTTONS As VbMsgBoxStyle, _
        Optional ByVal TITLE As String _
    ) As VbMsgBoxResult

The HyperlinkText argument takes the specific letter\word out of the prompt and will represent the clickable hyperlink display text.
The HyperlinkTarget argument takes a string that represents the hyperlink target (either a Folder address or a URL).

So, for instance:
IF
PROMPT = "Come visit MrExcel for all of your VBA programming needs.

"
HYPERLINK_TEXT = "MrExcel"
HYPERLINK_TARGET = "www.Mrexcel.com"
Then, the MrExcel word will be markedup and clicking on it will launch the www.Mrexcel.com website

1- API code in a Standard Module:

VBA Code:

Option Explicit

Private Enum DEACTIVATE_ACTCTX_FLAGS
    DEACTIVATE_ACTCTX_FLAG_NORMAL = 0
    DEACTIVATE_ACTCTX_FLAG_FORCE_EARLY_DEACTIVATION = 1
End Enum

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type InitCommonControlsEx
   Size As Long
   ICC As Long
End Type

#If Win64 Then
    Private Type ACTCTX 'ACTCTXW
        cbSize As Long
        dwFlags As Long
        lpSource As LongLong
        wProcessorArchitecture As Integer
        wLangId As Integer
        lpAssemblyDirectory As LongLong
        lpResourceName As LongLong
        lpApplicationName As LongLong
        hModule As LongLong
    End Type
#Else
    Private Type ACTCTX 'ACTCTXW
        cbSize As Long
        dwFlags As Long
        lpSource As Long
        wProcessorArchitecture As Integer
        wLangId As Integer
        lpAssemblyDirectory As Long
        lpResourceName As Long
        lpApplicationName As Long
        hModule As Long
    End Type
#End If

Private Const L_MAX_URL_LENGTH = 2048 + 32 + 3
Private Const MAX_LINKID_TEXT = 48

Private Type tagLITEM
  mask As Long
  iLink As Long
  state As Long
  stateMask As Long
  szID As String * MAX_LINKID_TEXT
  szUrl As String * L_MAX_URL_LENGTH
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #End If
        Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
        Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
        Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
        Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
        Private Declare PtrSafe Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsEx) As Long
        Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As LongPtr, ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, ByRef lpParam As Any) As LongPtr
        Private Declare PtrSafe Function ActivateActCtx Lib "kernel32" (ByVal hActCtx As LongPtr, ByRef Cookie As LongPtr) As Long
        Private Declare PtrSafe Function CreateActCtx Lib "kernel32" Alias "CreateActCtxW" (ByRef ACTCTX As ACTCTX) As LongPtr
        Private Declare PtrSafe Function DeactivateActCtx Lib "kernel32" (ByVal dwFlags As DEACTIVATE_ACTCTX_FLAGS, ByVal Cookie As LongPtr) As Long
        Private Declare PtrSafe Sub ReleaseActCtx Lib "kernel32" (ByVal hActCtx As LongPtr)
        Private Declare PtrSafe Function InitCommonControls Lib "Comctl32" () As Long
        Private Declare PtrSafe Function IsUserAnAdmin Lib "Shell32" () As Long
        Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As LongPtr) As LongPtr
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
        Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
        Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
        Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
        Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
        Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
        Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
        Private Declare PtrSafe Function GetBkColor Lib "gdi32" (ByVal hdc As LongPtr) As Long
        Private Declare PtrSafe Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
        Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    
        Private hHook As LongPtr, lPrevMsgBoxProc As LongPtr, lPrevSysLinkProc As LongPtr
        Private hActCtx As LongPtr, ActCtxCookie As LongPtr
#Else
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsEx) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
    Private Declare Function ActivateActCtx Lib "kernel32" (ByVal hActCtx As Long, ByRef Cookie As Long) As Long
    Private Declare Function CreateActCtx Lib "kernel32" Alias "CreateActCtxW" (ByRef ACTCTX As ACTCTX) As Long
    Private Declare Function DeactivateActCtx Lib "kernel32" (ByVal dwFlags As DEACTIVATE_ACTCTX_FLAGS, ByVal Cookie As Long) As Long
    Private Declare Sub ReleaseActCtx Lib "kernel32" (ByVal hActCtx As Long)
    Private Declare Function InitCommonControls Lib "Comctl32" () As Long
    Private Declare Function IsUserAnAdmin Lib "Shell32" () As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
    Private hHook As Long, lPrevMsgBoxProc As Long, lPrevSysLinkProc As Long
    Private hActCtx As Long, ActCtxCookie As Long
#End If
 
Private sCC6_MANIFEST_PATH As String
Private sStoredHypText As String
Private sStoredPrompt As String
Private sStoredLinkTarget As String    


Public Function HyperlinkMsgBox( _
        ByVal PROMPT As String, _
        ByVal HyperlinkText As String, _
        ByVal HyperlinkTarget As String, _
        Optional ByVal BUTTONS As VbMsgBoxStyle, _
        Optional ByVal TITLE As String _
    ) As VbMsgBoxResult
 
    Const WH_CBT = 5

    Call IfIdeRunApplyCC6ActCtx
        hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, GetModuleHandle(StrPtr(vbNullString)), GetCurrentThreadId)
        sStoredPrompt = PROMPT
        sStoredHypText = HyperlinkText
        sStoredLinkTarget = HyperlinkTarget
        HyperlinkMsgBox = MsgBox(sStoredPrompt, BUTTONS, TITLE)
        If hHook Then Call UnhookWindowsHookEx(hHook)
    Call RemoveCurrentActCtx
 
End Function

#If Win64 Then
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
        Static hSysLink As LongLong
        Dim hStatic As LongLong, hFont As LongLong
#Else
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Static hSysLink As Long
        Static hStatic As Long, hFont As Long
#End If

    Const HC_ACTION = 0
    Const HCBT_CREATEWND = 3
    Const HCBT_ACTIVATE = 5
    Const GWL_WNDPROC = -4
    Const IDPROMPT = &HFFFF&
    Const WM_GETFONT = &H31
    Const MAX_PATH = 260
    Const WS_CHILD = &H40000000
    Const WS_VISIBLE = &H10000000
    Const WS_TABSTOP = &H10000
    Const WC_LINK = "SysLink"
    Const ICC_LINK_CLASS = &H8000&
    Const WM_SETFONT = &H30
    Const WM_USER = &H400
    Const DM_GETDEFID = WM_USER + 0
    Const LWS_TRANSPARENT = 1
    Const WM_NEXTDLGCTL = &H28

    Dim tStaticRect As RECT, p1 As POINTAPI, tIccex As InitCommonControlsEx
    Dim sText As String * MAX_PATH
    Dim sLeftText As String, sRighTText As String
    Dim lLinkStyles As Long
 
    If lCode < HC_ACTION Then
        HookProc = CallNextHookEx(hHook, lCode, wParam, lParam)
        Exit Function
    End If
 
    If lCode = HCBT_ACTIVATE Then
        If IsMsgBox(wParam) Then
            Call UnhookWindowsHookEx(hHook): hHook = 0
            hStatic = GetDlgItem(wParam, IDPROMPT)
            If InStr(1, sStoredPrompt, sStoredHypText, vbTextCompare) Then
                hFont = SendMessage(hStatic, WM_GETFONT, 0, 0)
                With tStaticRect
                    Call GetWindowRect(hStatic, tStaticRect)
                    p1.X = .Left: p1.Y = .Top
                    Call ScreenToClient(wParam, p1)
                    Call DestroyWindow(hStatic)
                    Call MoveWindow(hSysLink, p1.X, p1.Y, .Right - .Left, .Bottom - .Top, 1)
                    Call SendMessage(hSysLink, WM_SETFONT, hFont, True)
                End With
                Call SendMessage(wParam, WM_NEXTDLGCTL, GetDlgItem(wParam, loword(CLng(SendMessage(wParam, DM_GETDEFID, 0, 0)))), True)
            End If
        End If
    End If
    
    If lCode = HCBT_CREATEWND Then
        If IsMsgBox(wParam) Then
            If InStr(1, sStoredPrompt, sStoredHypText, vbTextCompare) Then
                sLeftText = Left(sStoredPrompt, InStr(1, sStoredPrompt, sStoredHypText, vbTextCompare) - 1)
                sRighTText = Right(sStoredPrompt, Len(sStoredPrompt) - (InStr(1, sStoredPrompt, sStoredHypText, vbTextCompare) + Len(sStoredHypText) - 1))
                sText = sLeftText & "<a href=" & Chr(34) & vbNullString & Chr(34) & ">" & sStoredHypText & "</a>" & sRighTText
                With tIccex
                    .Size = LenB(tIccex)
                    .ICC = ICC_LINK_CLASS
                End With
                If InitCommonControlsEx(tIccex) Then
                    lPrevMsgBoxProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf MsgBoxProc)
                    lLinkStyles = LWS_TRANSPARENT + WS_CHILD + WS_VISIBLE + WS_TABSTOP
                    hSysLink = CreateWindowEx(0, StrPtr(WC_LINK), StrPtr(sText), lLinkStyles, 0, 0, 0, 0, wParam, 0, GetModuleHandle(StrPtr(vbNullString)), 0)
                    lPrevSysLinkProc = SetWindowLong(hSysLink, GWL_WNDPROC, AddressOf SysLinkProc)
                End If
            End If
        End If
    End If

    Call CallNextHookEx(hHook, lCode, wParam, lParam)
 
End Function

#If Win64 Then
    Private Function IsMsgBox(ByVal hwnd As LongLong) As Boolean
#Else
    Private Function IsMsgBox(ByVal hwnd As Long) As Boolean
#End If

    Const MAX_PATH = 260
    Dim sClassName As String * MAX_PATH, lRet As Long
 
    lRet = GetClassName(hwnd, sClassName, MAX_PATH)
    If Left$(sClassName, lRet) = "#32770" Then IsMsgBox = True

End Function

#If Win64 Then
    Private Function SysLinkProc(ByVal hwnd As LongLong, ByVal Msg As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function SysLinkProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const GWL_WNDPROC = -4
    Const WM_DESTROY = &H2
    Const WM_LBUTTONDOWN = &H201
    Const WM_KEYDOWN = &H100
    Const VK_RETURN = &HD

    Select Case Msg
        Case WM_KEYDOWN
            If wParam = VK_RETURN Then
                Call LaunchLink(sStoredLinkTarget)
                Call MakeLinkVisited(hwnd)
            End If
        Case WM_LBUTTONDOWN
            Call LaunchLink(sStoredLinkTarget)
            Call MakeLinkVisited(hwnd)
        Case WM_DESTROY
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevSysLinkProc)
    End Select
 
    SysLinkProc = CallWindowProc(lPrevSysLinkProc, hwnd, Msg, wParam, ByVal lParam)

End Function

#If Win64 Then
    Private Sub MakeLinkVisited(ByVal hwnd As LongLong)
#Else
    Private Sub MakeLinkVisited(ByVal hwnd As Long)
#End If

    Const LIF_ITEMINDEX = &H1
    Const LIF_STATE = &H2
    Const LIS_ENABLED = &H2
    Const LIS_VISITED = &H4
    Const WM_USER = &H400
    Const LM_SETITEM = (WM_USER + &H302)
    Dim tLitem As tagLITEM
 
    With tLitem
        .iLink = 0
        .mask = LIF_ITEMINDEX Or LIF_STATE
        .state = LIS_VISITED
        .stateMask = LIS_ENABLED
    End With
 
    Call SendMessage(hwnd, LM_SETITEM, 0, tLitem)

End Sub

Private Sub LaunchLink(ByVal sLinkAddr As String)

    Call ShellExecute(0, "open", sLinkAddr, vbNullString, vbNullString, 1)
    If Err.LastDllError <> 0 Then
        MsgBox "Wrong Link Target !", , "ERROR!"
    End If

End Sub

#If Win64 Then
    Private Function MsgBoxProc(ByVal hwnd As LongLong, ByVal Msg As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function MsgBoxProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const GWL_WNDPROC = -4
    Const WM_CTLCOLORDLG = &H136
    Const WM_CTLCOLORSTATIC = &H138
    Const WM_NCACTIVATE = &H86
    Const WM_DESTROY = &H2

    Select Case Msg
        Case WM_CTLCOLORDLG, WM_CTLCOLORSTATIC
            Call SendMessage(hwnd, WM_NCACTIVATE, True, 0)
            MsgBoxProc = CreateSolidBrush(GetBkColor(wParam))
            Exit Function
        Case WM_DESTROY
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevMsgBoxProc)
    End Select
 
    MsgBoxProc = CallWindowProc(lPrevMsgBoxProc, hwnd, Msg, wParam, ByVal lParam)

End Function

Private Function loword(DWord As Long) As Integer
    If DWord And &H8000& Then
        loword = DWord Or &HFFFF0000
    Else
        loword = DWord And &HFFFF&
    End If
End Function

Private Sub IfIdeRunApplyCC6ActCtx()

    Const WIN32_NULL = 0
    Dim ACTCTX As ACTCTX
 
    sCC6_MANIFEST_PATH = String$(1000, 0)
    Call GetTempFileName(Environ$("TEMP"), "test", 0, sCC6_MANIFEST_PATH)
    sCC6_MANIFEST_PATH = Left$(sCC6_MANIFEST_PATH, InStr(sCC6_MANIFEST_PATH, vbNullChar) - 1)
    Call CreateTempManifest(sCC6_MANIFEST_PATH)
    Do: DoEvents: Loop Until Len(Dir(sCC6_MANIFEST_PATH))
    If GetModuleHandle(StrPtr(vbNullString)) <> WIN32_NULL Then
        With ACTCTX
            .cbSize = LenB(ACTCTX)
            .lpSource = StrPtr(sCC6_MANIFEST_PATH)
        End With
        hActCtx = CreateActCtx(ACTCTX)
        Call ActivateActCtx(hActCtx, ActCtxCookie)
        Call IsUserAnAdmin
        Call InitCommonControls
    End If
 
End Sub

Private Sub RemoveCurrentActCtx()

    Const WIN32_NULL = 0

    If ActCtxCookie <> WIN32_NULL Then
        Call DeactivateActCtx(DEACTIVATE_ACTCTX_FLAG_NORMAL, ActCtxCookie)
        Call ReleaseActCtx(hActCtx)
        Call Kill(sCC6_MANIFEST_PATH)
    End If
 
End Sub

Private Sub CreateTempManifest(ByVal FilePathName As String)

    Dim fNr As Integer
    ReDim Bytes(0 To 574) As Byte
 
    Bytes(0) = 60: Bytes(1) = 63: Bytes(2) = 120: Bytes(3) = 109: Bytes(4) = 108: Bytes(5) = 32: Bytes(6) = 118: Bytes(7) = 101: Bytes(8) = 114: Bytes(9) = 115: Bytes(10) = 105: Bytes(11) = 111: Bytes(12) = 110: Bytes(13) = 61: Bytes(14) = 34: Bytes(15) = 49: Bytes(16) = 46: Bytes(17) = 48: Bytes(18) = 34: Bytes(19) = 32: Bytes(20) = 101: Bytes(21) = 110: Bytes(22) = 99: Bytes(23) = 111: Bytes(24) = 100: Bytes(25) = 105: Bytes(26) = 110: Bytes(27) = 103: Bytes(28) = 61: Bytes(29) = 34
    Bytes(30) = 85: Bytes(31) = 84: Bytes(32) = 70: Bytes(33) = 45: Bytes(34) = 56: Bytes(35) = 34: Bytes(36) = 32: Bytes(37) = 115: Bytes(38) = 116: Bytes(39) = 97: Bytes(40) = 110: Bytes(41) = 100: Bytes(42) = 97: Bytes(43) = 108: Bytes(44) = 111: Bytes(45) = 110: Bytes(46) = 101: Bytes(47) = 61: Bytes(48) = 34: Bytes(49) = 121: Bytes(50) = 101: Bytes(51) = 115: Bytes(52) = 34: Bytes(53) = 63: Bytes(54) = 62: Bytes(55) = 13: Bytes(56) = 10: Bytes(57) = 60: Bytes(58) = 97: Bytes(59) = 115
    Bytes(60) = 115: Bytes(61) = 101: Bytes(62) = 109: Bytes(63) = 98: Bytes(64) = 108: Bytes(65) = 121: Bytes(66) = 32: Bytes(67) = 120: Bytes(68) = 109: Bytes(69) = 108: Bytes(70) = 110: Bytes(71) = 115: Bytes(72) = 61: Bytes(73) = 34: Bytes(74) = 117: Bytes(75) = 114: Bytes(76) = 110: Bytes(77) = 58: Bytes(78) = 115: Bytes(79) = 99: Bytes(80) = 104: Bytes(81) = 101: Bytes(82) = 109: Bytes(83) = 97: Bytes(84) = 115: Bytes(85) = 45: Bytes(86) = 109: Bytes(87) = 105: Bytes(88) = 99: Bytes(89) = 114
    Bytes(90) = 111: Bytes(91) = 115: Bytes(92) = 111: Bytes(93) = 102: Bytes(94) = 116: Bytes(95) = 45: Bytes(96) = 99: Bytes(97) = 111: Bytes(98) = 109: Bytes(99) = 58: Bytes(100) = 97: Bytes(101) = 115: Bytes(102) = 109: Bytes(103) = 46: Bytes(104) = 118: Bytes(105) = 49: Bytes(106) = 34: Bytes(107) = 32: Bytes(108) = 109: Bytes(109) = 97: Bytes(110) = 110: Bytes(111) = 105: Bytes(112) = 102: Bytes(113) = 101: Bytes(114) = 115: Bytes(115) = 116: Bytes(116) = 86: Bytes(117) = 101: Bytes(118) = 114: Bytes(119) = 115
    Bytes(120) = 105: Bytes(121) = 111: Bytes(122) = 110: Bytes(123) = 61: Bytes(124) = 34: Bytes(125) = 49: Bytes(126) = 46: Bytes(127) = 48: Bytes(128) = 34: Bytes(129) = 62: Bytes(130) = 13: Bytes(131) = 10: Bytes(132) = 60: Bytes(133) = 97: Bytes(134) = 115: Bytes(135) = 115: Bytes(136) = 101: Bytes(137) = 109: Bytes(138) = 98: Bytes(139) = 108: Bytes(140) = 121: Bytes(141) = 73: Bytes(142) = 100: Bytes(143) = 101: Bytes(144) = 110: Bytes(145) = 116: Bytes(146) = 105: Bytes(147) = 116: Bytes(148) = 121: Bytes(149) = 13
    Bytes(150) = 10: Bytes(151) = 118: Bytes(152) = 101: Bytes(153) = 114: Bytes(154) = 115: Bytes(155) = 105: Bytes(156) = 111: Bytes(157) = 110: Bytes(158) = 61: Bytes(159) = 34: Bytes(160) = 49: Bytes(161) = 46: Bytes(162) = 48: Bytes(163) = 46: Bytes(164) = 48: Bytes(165) = 46: Bytes(166) = 48: Bytes(167) = 34: Bytes(168) = 13: Bytes(169) = 10: Bytes(170) = 112: Bytes(171) = 114: Bytes(172) = 111: Bytes(173) = 99: Bytes(174) = 101: Bytes(175) = 115: Bytes(176) = 115: Bytes(177) = 111: Bytes(178) = 114: Bytes(179) = 65
    Bytes(180) = 114: Bytes(181) = 99: Bytes(182) = 104: Bytes(183) = 105: Bytes(184) = 116: Bytes(185) = 101: Bytes(186) = 99: Bytes(187) = 116: Bytes(188) = 117: Bytes(189) = 114: Bytes(190) = 101: Bytes(191) = 61: Bytes(192) = 34: Bytes(193) = 42: Bytes(194) = 34: Bytes(195) = 13: Bytes(196) = 10: Bytes(197) = 110: Bytes(198) = 97: Bytes(199) = 109: Bytes(200) = 101: Bytes(201) = 61: Bytes(202) = 34: Bytes(203) = 67: Bytes(204) = 111: Bytes(205) = 109: Bytes(206) = 112: Bytes(207) = 97: Bytes(208) = 110: Bytes(209) = 121
    Bytes(210) = 78: Bytes(211) = 97: Bytes(212) = 109: Bytes(213) = 101: Bytes(214) = 46: Bytes(215) = 80: Bytes(216) = 114: Bytes(217) = 111: Bytes(218) = 100: Bytes(219) = 117: Bytes(220) = 99: Bytes(221) = 116: Bytes(222) = 78: Bytes(223) = 97: Bytes(224) = 109: Bytes(225) = 101: Bytes(226) = 46: Bytes(227) = 89: Bytes(228) = 111: Bytes(229) = 117: Bytes(230) = 114: Bytes(231) = 65: Bytes(232) = 112: Bytes(233) = 112: Bytes(234) = 34: Bytes(235) = 13: Bytes(236) = 10: Bytes(237) = 116: Bytes(238) = 121: Bytes(239) = 112
    Bytes(240) = 101: Bytes(241) = 61: Bytes(242) = 34: Bytes(243) = 119: Bytes(244) = 105: Bytes(245) = 110: Bytes(246) = 51: Bytes(247) = 50: Bytes(248) = 34: Bytes(249) = 13: Bytes(250) = 10: Bytes(251) = 47: Bytes(252) = 62: Bytes(253) = 13: Bytes(254) = 10: Bytes(255) = 60: Bytes(256) = 100: Bytes(257) = 101: Bytes(258) = 115: Bytes(259) = 99: Bytes(260) = 114: Bytes(261) = 105: Bytes(262) = 112: Bytes(263) = 116: Bytes(264) = 105: Bytes(265) = 111: Bytes(266) = 110: Bytes(267) = 62: Bytes(268) = 89: Bytes(269) = 111
    Bytes(270) = 117: Bytes(271) = 114: Bytes(272) = 32: Bytes(273) = 97: Bytes(274) = 112: Bytes(275) = 112: Bytes(276) = 108: Bytes(277) = 105: Bytes(278) = 99: Bytes(279) = 97: Bytes(280) = 116: Bytes(281) = 105: Bytes(282) = 111: Bytes(283) = 110: Bytes(284) = 32: Bytes(285) = 100: Bytes(286) = 101: Bytes(287) = 115: Bytes(288) = 99: Bytes(289) = 114: Bytes(290) = 105: Bytes(291) = 112: Bytes(292) = 116: Bytes(293) = 105: Bytes(294) = 111: Bytes(295) = 110: Bytes(296) = 32: Bytes(297) = 104: Bytes(298) = 101: Bytes(299) = 114
    Bytes(300) = 101: Bytes(301) = 46: Bytes(302) = 60: Bytes(303) = 47: Bytes(304) = 100: Bytes(305) = 101: Bytes(306) = 115: Bytes(307) = 99: Bytes(308) = 114: Bytes(309) = 105: Bytes(310) = 112: Bytes(311) = 116: Bytes(312) = 105: Bytes(313) = 111: Bytes(314) = 110: Bytes(315) = 62: Bytes(316) = 13: Bytes(317) = 10: Bytes(318) = 60: Bytes(319) = 100: Bytes(320) = 101: Bytes(321) = 112: Bytes(322) = 101: Bytes(323) = 110: Bytes(324) = 100: Bytes(325) = 101: Bytes(326) = 110: Bytes(327) = 99: Bytes(328) = 121: Bytes(329) = 62
    Bytes(330) = 13: Bytes(331) = 10: Bytes(332) = 60: Bytes(333) = 100: Bytes(334) = 101: Bytes(335) = 112: Bytes(336) = 101: Bytes(337) = 110: Bytes(338) = 100: Bytes(339) = 101: Bytes(340) = 110: Bytes(341) = 116: Bytes(342) = 65: Bytes(343) = 115: Bytes(344) = 115: Bytes(345) = 101: Bytes(346) = 109: Bytes(347) = 98: Bytes(348) = 108: Bytes(349) = 121: Bytes(350) = 62: Bytes(351) = 13: Bytes(352) = 10: Bytes(353) = 60: Bytes(354) = 97: Bytes(355) = 115: Bytes(356) = 115: Bytes(357) = 101: Bytes(358) = 109: Bytes(359) = 98
    Bytes(360) = 108: Bytes(361) = 121: Bytes(362) = 73: Bytes(363) = 100: Bytes(364) = 101: Bytes(365) = 110: Bytes(366) = 116: Bytes(367) = 105: Bytes(368) = 116: Bytes(369) = 121: Bytes(370) = 13: Bytes(371) = 10: Bytes(372) = 116: Bytes(373) = 121: Bytes(374) = 112: Bytes(375) = 101: Bytes(376) = 61: Bytes(377) = 34: Bytes(378) = 119: Bytes(379) = 105: Bytes(380) = 110: Bytes(381) = 51: Bytes(382) = 50: Bytes(383) = 34: Bytes(384) = 13: Bytes(385) = 10: Bytes(386) = 110: Bytes(387) = 97: Bytes(388) = 109: Bytes(389) = 101
    Bytes(390) = 61: Bytes(391) = 34: Bytes(392) = 77: Bytes(393) = 105: Bytes(394) = 99: Bytes(395) = 114: Bytes(396) = 111: Bytes(397) = 115: Bytes(398) = 111: Bytes(399) = 102: Bytes(400) = 116: Bytes(401) = 46: Bytes(402) = 87: Bytes(403) = 105: Bytes(404) = 110: Bytes(405) = 100: Bytes(406) = 111: Bytes(407) = 119: Bytes(408) = 115: Bytes(409) = 46: Bytes(410) = 67: Bytes(411) = 111: Bytes(412) = 109: Bytes(413) = 109: Bytes(414) = 111: Bytes(415) = 110: Bytes(416) = 45: Bytes(417) = 67: Bytes(418) = 111: Bytes(419) = 110
    Bytes(420) = 116: Bytes(421) = 114: Bytes(422) = 111: Bytes(423) = 108: Bytes(424) = 115: Bytes(425) = 34: Bytes(426) = 13: Bytes(427) = 10: Bytes(428) = 118: Bytes(429) = 101: Bytes(430) = 114: Bytes(431) = 115: Bytes(432) = 105: Bytes(433) = 111: Bytes(434) = 110: Bytes(435) = 61: Bytes(436) = 34: Bytes(437) = 54: Bytes(438) = 46: Bytes(439) = 48: Bytes(440) = 46: Bytes(441) = 48: Bytes(442) = 46: Bytes(443) = 48: Bytes(444) = 34: Bytes(445) = 13: Bytes(446) = 10: Bytes(447) = 112: Bytes(448) = 114: Bytes(449) = 111
    Bytes(450) = 99: Bytes(451) = 101: Bytes(452) = 115: Bytes(453) = 115: Bytes(454) = 111: Bytes(455) = 114: Bytes(456) = 65: Bytes(457) = 114: Bytes(458) = 99: Bytes(459) = 104: Bytes(460) = 105: Bytes(461) = 116: Bytes(462) = 101: Bytes(463) = 99: Bytes(464) = 116: Bytes(465) = 117: Bytes(466) = 114: Bytes(467) = 101: Bytes(468) = 61: Bytes(469) = 34: Bytes(470) = 42: Bytes(471) = 34: Bytes(472) = 13: Bytes(473) = 10: Bytes(474) = 112: Bytes(475) = 117: Bytes(476) = 98: Bytes(477) = 108: Bytes(478) = 105: Bytes(479) = 99
    Bytes(480) = 75: Bytes(481) = 101: Bytes(482) = 121: Bytes(483) = 84: Bytes(484) = 111: Bytes(485) = 107: Bytes(486) = 101: Bytes(487) = 110: Bytes(488) = 61: Bytes(489) = 34: Bytes(490) = 54: Bytes(491) = 53: Bytes(492) = 57: Bytes(493) = 53: Bytes(494) = 98: Bytes(495) = 54: Bytes(496) = 52: Bytes(497) = 49: Bytes(498) = 52: Bytes(499) = 52: Bytes(500) = 99: Bytes(501) = 99: Bytes(502) = 102: Bytes(503) = 49: Bytes(504) = 100: Bytes(505) = 102: Bytes(506) = 34: Bytes(507) = 13: Bytes(508) = 10: Bytes(509) = 108
    Bytes(510) = 97: Bytes(511) = 110: Bytes(512) = 103: Bytes(513) = 117: Bytes(514) = 97: Bytes(515) = 103: Bytes(516) = 101: Bytes(517) = 61: Bytes(518) = 34: Bytes(519) = 42: Bytes(520) = 34: Bytes(521) = 13: Bytes(522) = 10: Bytes(523) = 47: Bytes(524) = 62: Bytes(525) = 13: Bytes(526) = 10: Bytes(527) = 60: Bytes(528) = 47: Bytes(529) = 100: Bytes(530) = 101: Bytes(531) = 112: Bytes(532) = 101: Bytes(533) = 110: Bytes(534) = 100: Bytes(535) = 101: Bytes(536) = 110: Bytes(537) = 116: Bytes(538) = 65: Bytes(539) = 115
    Bytes(540) = 115: Bytes(541) = 101: Bytes(542) = 109: Bytes(543) = 98: Bytes(544) = 108: Bytes(545) = 121: Bytes(546) = 62: Bytes(547) = 13: Bytes(548) = 10: Bytes(549) = 60: Bytes(550) = 47: Bytes(551) = 100: Bytes(552) = 101: Bytes(553) = 112: Bytes(554) = 101: Bytes(555) = 110: Bytes(556) = 100: Bytes(557) = 101: Bytes(558) = 110: Bytes(559) = 99: Bytes(560) = 121: Bytes(561) = 62: Bytes(562) = 13: Bytes(563) = 10: Bytes(564) = 60: Bytes(565) = 47: Bytes(566) = 97: Bytes(567) = 115: Bytes(568) = 115: Bytes(569) = 101
    Bytes(570) = 109: Bytes(571) = 98: Bytes(572) = 108: Bytes(573) = 121: Bytes(574) = 62:
 
    fNr = FreeFile()
    Open FilePathName For Binary As #fNr
        Put #fNr, 1, Bytes
    Close #fNr
 
End Sub

2- Code usage examples:

VBA Code:

Option Explicit

Sub Test1()

    Const PROMPT = "Click this Hyperlink text to launch your C:\ Drive folder from explorer"
    Const TITLE = "Testing ..."
    Const HYPERLINK_TEXT = "Hyperlink"
    Const HYPERLINK_TARGET = "C:\"
    Const BUTTONS = vbInformation
    Dim lRet As VbMsgBoxResult

    lRet = HyperlinkMsgBox(PROMPT, HYPERLINK_TEXT, HYPERLINK_TARGET, BUTTONS, TITLE)

End Sub


Sub Test2()

    Const PROMPT = vbNewLine & "Come visit MrExcel for all of your VBA programming needs. :)"
    Const TITLE = "Hello EXCEL/VBA/ world ! "
    Const HYPERLINK_TEXT = "MrExcel"
    Const HYPERLINK_TARGET = "www.Mrexcel.com"
    Const BUTTONS = vbInformation
    Dim lRet As VbMsgBoxResult

    lRet = HyperlinkMsgBox(PROMPT, HYPERLINK_TEXT, HYPERLINK_TARGET, BUTTONS, TITLE)

End Sub

Late note;
I have written and tested this code in excel 2016 x64bit - I haven't tested it on other platforms but, I guess, it should work just as well.
In case of any issues, please let me know.

tubrak · Jun 29, 2021

Here is an example of how to prompt the user to open directly the "C:\aa\bb.pdf" file :

fantastic !
I use win10 , 64bit and office2019
many thanks genius

Jaafar Tribak · Jul 1, 2021

Hi again,

The previous code had an annoying limitation in that it was impossible to insert more than one hyperlink at a time. This new update fixed this problem and now allows for the use of multiple hyperlinks.

File demo:
MultipleHyperlinkMsgBox.xls

Each marked-up text is associated with a corresponding Hyperlink target. You must set up the text-link associations in a 2D string array before passing the array to the 'HyperlinkMsgBox' custom function

PREVIEW:

1- API code in a Standard Module:

VBA Code:

Option Explicit

Private Enum DEACTIVATE_ACTCTX_FLAGS
    DEACTIVATE_ACTCTX_FLAG_NORMAL = 0
    DEACTIVATE_ACTCTX_FLAG_FORCE_EARLY_DEACTIVATION = 1
End Enum

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type InitCommonControlsEx
   Size As Long
   ICC As Long
End Type

#If Win64 Then
    Private Type ACTCTX 'ACTCTXW
        cbSize As Long
        dwFlags As Long
        lpSource As LongLong
        wProcessorArchitecture As Integer
        wLangId As Integer
        lpAssemblyDirectory As LongLong
        lpResourceName As LongLong
        lpApplicationName As LongLong
        hModule As LongLong
    End Type
#Else
    Private Type ACTCTX 'ACTCTXW
        cbSize As Long
        dwFlags As Long
        lpSource As Long
        wProcessorArchitecture As Integer
        wLangId As Integer
        lpAssemblyDirectory As Long
        lpResourceName As Long
        lpApplicationName As Long
        hModule As Long
    End Type
#End If

Private Const L_MAX_URL_LENGTH = 2048 + 32 + 3
Private Const MAX_LINKID_TEXT = 48

Private Type tagLITEM
  mask As Long
  iLink As Long
  state As Long
  stateMask As Long
  szID As String * MAX_LINKID_TEXT
  szUrl As String * L_MAX_URL_LENGTH
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal arg1 As LongLong, ppacc As Any, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
        Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
        Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
        Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
        Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
        Private Declare PtrSafe Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsEx) As Long
        Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As LongPtr, ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, ByRef lpParam As Any) As LongPtr
        Private Declare PtrSafe Function ActivateActCtx Lib "kernel32" (ByVal hActCtx As LongPtr, ByRef Cookie As LongPtr) As Long
        Private Declare PtrSafe Function CreateActCtx Lib "kernel32" Alias "CreateActCtxW" (ByRef ACTCTX As ACTCTX) As LongPtr
        Private Declare PtrSafe Function DeactivateActCtx Lib "kernel32" (ByVal dwFlags As DEACTIVATE_ACTCTX_FLAGS, ByVal Cookie As LongPtr) As Long
        Private Declare PtrSafe Sub ReleaseActCtx Lib "kernel32" (ByVal hActCtx As LongPtr)
        Private Declare PtrSafe Function InitCommonControls Lib "Comctl32" () As Long
        Private Declare PtrSafe Function IsUserAnAdmin Lib "Shell32" () As Long
        Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As LongPtr) As LongPtr
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
        Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
        Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
        Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
        Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
        Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
        Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
        Private Declare PtrSafe Function GetBkColor Lib "gdi32" (ByVal hDc As LongPtr) As Long
        Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
        Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
        Private Declare PtrSafe Function AccessibleChildren Lib "Oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
        Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
        Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
        Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
        Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
        Private Declare PtrSafe Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDc As LongPtr, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
        
        Private hHook As LongPtr, lPrevMsgBoxProc As LongPtr, lPrevSysLinkProc As LongPtr
        Private hActCtx As LongPtr, ActCtxCookie As LongPtr
#Else
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsEx) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
    Private Declare Function ActivateActCtx Lib "kernel32" (ByVal hActCtx As Long, ByRef Cookie As Long) As Long
    Private Declare Function CreateActCtx Lib "kernel32" Alias "CreateActCtxW" (ByRef ACTCTX As ACTCTX) As Long
    Private Declare Function DeactivateActCtx Lib "kernel32" (ByVal dwFlags As DEACTIVATE_ACTCTX_FLAGS, ByVal Cookie As Long) As Long
    Private Declare Sub ReleaseActCtx Lib "kernel32" (ByVal hActCtx As Long)
    Private Declare Function InitCommonControls Lib "Comctl32" () As Long
    Private Declare Function IsUserAnAdmin Lib "Shell32" () As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal pModuleName As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Private Declare Function GetBkColor Lib "gdi32" (ByVal hDc As Long) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Declare Function AccessibleChildren Lib "Oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
    Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

    Private hHook As Long, lPrevMsgBoxProc As Long, lPrevSysLinkProc As Long
    Private hActCtx As Long, ActCtxCookie As Long
#End If
    
    
Private sCC6_MANIFEST_PATH As String

Private sStoredLinkPairsArray() As String
Private sStoredLinksArray() As String
Private sStoredTargetsArray() As String
Private sStoredPrompt As String



Public Function HyperlinkMsgBox( _
        ByVal PROMPT As String, _
        HyperlinkPairsArray() As String, _
        Optional ByVal BUTTONS As VbMsgBoxStyle, _
        Optional ByVal TITLE As String _
    ) As VbMsgBoxResult
    
    Const WH_CBT = 5
    Dim i As Long
    
    ReDim Hyps(UBound(HyperlinkPairsArray, 1), 1)
    sStoredLinkPairsArray = HyperlinkPairsArray
    
    For i = LBound(HyperlinkPairsArray, 1) To UBound(HyperlinkPairsArray, 1)
        If InStr(1, PROMPT, HyperlinkPairsArray(i, 0), vbTextCompare) = 0 Then
            GoTo errHandler1
        End If
        If Len(HyperlinkPairsArray(i, 0)) = 0 Then
            GoTo errHandler2
        End If
        ReDim Preserve sStoredTargetsArray(i)
        ReDim Preserve sStoredLinksArray(i)
        sStoredTargetsArray(i) = HyperlinkPairsArray(i, 1)
        sStoredLinksArray(i) = HyperlinkPairsArray(i, 0)
    Next i
       
    Call IfIdeRunApplyCC6ActCtx
        hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, GetModuleHandle(StrPtr(vbNullString)), GetCurrentThreadId)
        sStoredPrompt = PROMPT
        HyperlinkMsgBox = MsgBox(sStoredPrompt, BUTTONS, TITLE)
        If hHook Then Call UnhookWindowsHookEx(hHook)
    Call RemoveCurrentActCtx

    Exit Function
    
errHandler1:
   MsgBox "Error !" & vbNewLine & vbNewLine & "There is an error in the values assigned to the Hyperlinks array. " & _
   "The letter\word : (" & HyperlinkPairsArray(i, 0) & ") doesn't exist in the MsgBox Prompt." & vbNewLine & vbNewLine & _
   "Go back and make the necessary corrections.", vbExclamation
   Exit Function

errHandler2:
   MsgBox "Error !" & vbNewLine & vbNewLine & "One or more of the elements in the Hyperlinks array hold(s) an empty string or " & _
   "the size of the Hyperlinks array doesn't match the number of its populated elements." & vbNewLine & vbNewLine & _
   "Go back and make the necessary corrections.", vbExclamation
    
End Function



'______________________________________PRIVATE ROUTINES__________________________________________

#If Win64 Then
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
        Static hSysLink As LongLong
        Dim hStatic As LongLong, hFont As LongLong, hDc As LongLong
#Else
    Private Function HookProc(ByVal lCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Static hSysLink As Long
        Dim hStatic As Long, hFont As Long, hDc As Long
#End If

    Const HC_ACTION = 0
    Const HCBT_CREATEWND = 3
    Const HCBT_ACTIVATE = 5
    Const GWL_WNDPROC = -4
    Const IDPROMPT = &HFFFF&
    Const WM_GETFONT = &H31
    Const MAX_PATH = 260
    Const WS_CHILD = &H40000000
    Const WS_VISIBLE = &H10000000
    Const WS_TABSTOP = &H10000
    Const WC_LINK = "SysLink"
    Const ICC_LINK_CLASS = &H8000&
    Const WM_SETFONT = &H30
    Const WM_USER = &H400
    Const DM_GETDEFID = WM_USER
    Const LWS_TRANSPARENT = 1
    Const WM_NEXTDLGCTL = &H28
    Const DT_CALCRECT = &H400

    Dim tStaticRect As RECT, tTextRect As RECT, p1 As POINTAPI, tIccex As InitCommonControlsEx
    Dim sLeftText As String, sRighTText As String
    Dim lLinkStyles As Long
    Dim lRet As Long, lPos As Long
    Dim lTempVal As Long, i As Long, j As Long
    Dim YOffset As Long
    Dim sFormattedPrompt As String, sHref As String
    Dim sUnSortedLinksArray() As String
    Dim lUnSortedLinksIndexesArray() As Long
    Dim lSortedLinksIndexesArray() As Long
    
    
    If lCode < HC_ACTION Then
        HookProc = CallNextHookEx(hHook, lCode, wParam, lParam)
        Exit Function
    End If
    
    If lCode = HCBT_ACTIVATE Then
        If IsMsgBox(wParam) Then
            Call UnhookWindowsHookEx(hHook): hHook = 0
            hStatic = GetDlgItem(wParam, IDPROMPT)
            If InStr(1, sStoredPrompt, sStoredLinkPairsArray(0, 0), vbTextCompare) Then
                hFont = SendMessage(hStatic, WM_GETFONT, 0, 0)
                With tStaticRect
                    Call GetWindowRect(hStatic, tStaticRect)
                    p1.X = .Left: p1.Y = .Top
                    Call ScreenToClient(wParam, p1)
                    Call DestroyWindow(hStatic)
                    Call SendMessage(hSysLink, WM_SETFONT, hFont, True)
                    hDc = GetDC(hSysLink)
                    Call DrawText(hDc, "a", Len("a"), tTextRect, DT_CALCRECT)
                    Call ReleaseDC(hSysLink, hDc)
                    With tTextRect
                        YOffset = .Bottom - .Top
                    End With
                    Call MoveWindow(hSysLink, p1.X, p1.Y, .Right - .Left, .Bottom - .Top + YOffset, 1)
                End With
                Call SendMessage(wParam, WM_NEXTDLGCTL, GetDlgItem(wParam, loword(CLng(SendMessage(wParam, DM_GETDEFID, 0, 0)))), True)
            End If
        End If
    End If
        
    If lCode = HCBT_CREATEWND Then
        If IsMsgBox(wParam) Then
            lPos = 1
            For i = LBound(sStoredLinkPairsArray, 1) To UBound(sStoredLinkPairsArray, 1)
                Do
                    lRet = InStr(lPos, sStoredPrompt, sStoredLinkPairsArray(i, 0), vbTextCompare)
                    If lRet Then
                        lPos = lRet + Len(sStoredLinkPairsArray(i, 0))
                        ReDim Preserve lSortedLinksIndexesArray(j)
                        ReDim Preserve sUnSortedLinksArray(j)
                        ReDim Preserve lUnSortedLinksIndexesArray(j)
                        lUnSortedLinksIndexesArray(j) = lRet
                        lSortedLinksIndexesArray(j) = lRet
                        sUnSortedLinksArray(j) = sStoredLinkPairsArray(i, 0)
                        j = j + 1
                    End If
                    DoEvents
                Loop Until lRet = 0
                lPos = 1
                lRet = 0
            Next i
    
            For i = 0 To UBound(lSortedLinksIndexesArray)
               For j = UBound(lSortedLinksIndexesArray) To i + 1 Step -1
                  If lSortedLinksIndexesArray(j) < lSortedLinksIndexesArray(i) Then
                     lTempVal = lSortedLinksIndexesArray(j)
                     lSortedLinksIndexesArray(j) = lSortedLinksIndexesArray(i)
                     lSortedLinksIndexesArray(i) = lTempVal
                  End If
               Next j
            Next i
    
            ReDim sSortedLiksArray(UBound(lSortedLinksIndexesArray))
            For i = 0 To UBound(lSortedLinksIndexesArray)
                With Application.WorksheetFunction
                    sSortedLiksArray(i) = .Index(sUnSortedLinksArray, .Match(lSortedLinksIndexesArray(i), lUnSortedLinksIndexesArray, 0))
                End With
            Next i
             
             sFormattedPrompt = sStoredPrompt
            For i = 0 To UBound(sSortedLiksArray)
                sFormattedPrompt = Replace(sFormattedPrompt, sSortedLiksArray(i), "|*|", , , vbTextCompare)
            Next i
            
            sHref = "<a href=" & Chr(34) & vbNullString & Chr(34) & ">"
            For i = 0 To UBound(sSortedLiksArray)
                sFormattedPrompt = Replace(sFormattedPrompt, "|*|", sHref & sSortedLiksArray(i) & "</a>", 1, 1, vbTextCompare)
            Next i

                With tIccex
                    .Size = LenB(tIccex)
                    .ICC = ICC_LINK_CLASS
                End With
                
                If InitCommonControlsEx(tIccex) Then
                    lPrevMsgBoxProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf MsgBoxProc)
                    lLinkStyles = LWS_TRANSPARENT + WS_CHILD + WS_VISIBLE + WS_TABSTOP
                    hSysLink = CreateWindowEx(0, StrPtr(WC_LINK), StrPtr(sFormattedPrompt), lLinkStyles, 0, 0, 0, 0, wParam, 0, GetModuleHandle(StrPtr(vbNullString)), 0)
                    If hSysLink Then
                        lPrevSysLinkProc = SetWindowLong(hSysLink, GWL_WNDPROC, AddressOf SysLinkProc)
                    Else
                        Call SetWindowLong(wParam, GWL_WNDPROC, lPrevMsgBoxProc)
                        GoTo Failed
                   End If
                Else
                   GoTo Failed
                End If
        End If
    End If
    
    GoTo Xit

Failed:
    Call UnhookWindowsHookEx(hHook): hHook = 0
    MsgBox "Unable to create the Hyperlink(s)", , "ERROR!"
    
Xit:

    Call CallNextHookEx(hHook, lCode, wParam, lParam)
    
End Function


#If Win64 Then
    Private Function IsMsgBox(ByVal hwnd As LongLong) As Boolean
#Else
    Private Function IsMsgBox(ByVal hwnd As Long) As Boolean
#End If

    Const MAX_PATH = 260
    Dim sClassName As String * MAX_PATH, lRet As Long
    
    lRet = GetClassName(hwnd, sClassName, MAX_PATH)
    If Left$(sClassName, lRet) = "#32770" Then IsMsgBox = True

End Function


#If Win64 Then
    Private Function SysLinkProc(ByVal hwnd As LongLong, ByVal Msg As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function SysLinkProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const GWL_WNDPROC = -4
    Const WM_DESTROY = &H2
    Const WM_LBUTTONDOWN = &H201
    Const WM_KEYDOWN = &H100
    Const VK_RETURN = &HD
    Const STATE_SYSTEM_FOCUSED = &H4&
    Const OBJID_CLIENT = &HFFFFFFFC
    Const S_OK = &H0&
    Const ID_ACCESSIBLE = "{618736E0-3C3D-11CF-810C-00AA00389B71}"

    Dim tGUID(0 To 3) As Long, oAccClient  As IAccessible, vAccContainer As Variant
    Dim oIAcc As IAccessible, vKid As Variant, sAccName As String, sLinkAddr As String
    Dim tCurPos As POINTAPI, i As Long

    On Error Resume Next

    Select Case Msg
    
        Case WM_KEYDOWN
            If wParam = VK_RETURN Then
                If IIDFromString(StrPtr(ID_ACCESSIBLE), VarPtr(tGUID(0))) = S_OK Then
                    If AccessibleObjectFromWindow(hwnd, OBJID_CLIENT, VarPtr(tGUID(0)), oAccClient) = S_OK Then
                        Set vAccContainer = oAccClient
                        Do
                            i = i + 1
                            Call AccessibleChildren(vAccContainer, 0, 1, vAccContainer, 1)
                            If CBool(oAccClient.accState(i) And (STATE_SYSTEM_FOCUSED)) Then
                                Call MakeLinkVisited(hwnd, i)
                                With Application.WorksheetFunction
                                    sLinkAddr = sStoredTargetsArray(.Match(oAccClient.accName(i), sStoredLinksArray, 0) - 1)
                                    If Len(sLinkAddr) Then
                                        Call LaunchLink(sLinkAddr)
                                    End If
                                End With
                            End If
                            DoEvents
                        Loop Until i >= oAccClient.accChildCount
                    End If
                End If
            End If
            
        Case WM_LBUTTONDOWN
            Call GetCursorPos(tCurPos)
            #If Win64 Then
                Dim Ptr As LongLong
                Call CopyMemory(Ptr, tCurPos, LenB(tCurPos))
                Call AccessibleObjectFromPoint(Ptr, oIAcc, vKid)
            #Else
                Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, oIAcc, vKid)
            #End If
            sAccName = oIAcc.accName(vKid)
            Call MakeLinkVisited(hwnd, vKid)
            With Application.WorksheetFunction
                sLinkAddr = sStoredTargetsArray(.Match(sAccName, sStoredLinksArray, 0) - 1)
                If Len(sLinkAddr) Then
                    Call LaunchLink(sLinkAddr)
                End If
            End With
   
        Case WM_DESTROY
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevSysLinkProc)
            
    End Select
    
    SysLinkProc = CallWindowProc(lPrevSysLinkProc, hwnd, Msg, wParam, ByVal lParam)

End Function


#If Win64 Then
    Private Sub MakeLinkVisited(ByVal hwnd As LongLong, ByVal HypIndex As Long)
#Else
    Private Sub MakeLinkVisited(ByVal hwnd As Long, ByVal HypIndex As Long)
#End If
    
    Const LIF_ITEMINDEX = &H1
    Const LIF_STATE = &H2
    Const LIS_ENABLED = &H2
    Const LIS_VISITED = &H4
    Const WM_USER = &H400
    Const LM_SETITEM = (WM_USER + &H302)
    Dim tLitem As tagLITEM
 
    With tLitem
        .iLink = HypIndex - 1
        .mask = LIF_ITEMINDEX Or LIF_STATE
        .state = LIS_VISITED
        .stateMask = LIS_ENABLED
    End With
    
    Call SendMessage(hwnd, LM_SETITEM, 0, tLitem)

End Sub


Private Sub LaunchLink(ByVal sLinkAddr As String)

    Call ShellExecute(0, "open", sLinkAddr, vbNullString, vbNullString, 1)
    If Err.LastDllError <> 0 Then
        MsgBox "Wrong Link Target !", , "ERROR!"
    End If

End Sub


#If Win64 Then
    Private Function MsgBoxProc(ByVal hwnd As LongLong, ByVal Msg As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function MsgBoxProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const GWL_WNDPROC = -4
    Const WM_CTLCOLORDLG = &H136
    Const WM_CTLCOLORSTATIC = &H138
    Const WM_NCACTIVATE = &H86
    Const WM_DESTROY = &H2
    Const COLOR_WINDOW = 5
    
    Select Case Msg
        Case WM_CTLCOLORSTATIC, WM_CTLCOLORDLG
            Call SendMessage(hwnd, WM_NCACTIVATE, True, 0)
            MsgBoxProc = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
            Exit Function
        Case WM_DESTROY
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevMsgBoxProc)
            Erase sStoredLinkPairsArray
            Erase sStoredTargetsArray
    End Select
        
    MsgBoxProc = CallWindowProc(lPrevMsgBoxProc, hwnd, Msg, wParam, ByVal lParam)

End Function


Private Function loword(DWord As Long) As Integer
    If DWord And &H8000& Then
        loword = DWord Or &HFFFF0000
    Else
        loword = DWord And &HFFFF&
    End If
End Function


Private Sub IfIdeRunApplyCC6ActCtx()

    Const WIN32_NULL = 0
    Dim ACTCTX As ACTCTX
    
    sCC6_MANIFEST_PATH = String$(1000, 0)
    Call GetTempFileName(Environ$("TEMP"), "test", 0, sCC6_MANIFEST_PATH)
    sCC6_MANIFEST_PATH = Left$(sCC6_MANIFEST_PATH, InStr(sCC6_MANIFEST_PATH, vbNullChar) - 1)
    Call CreateTempManifest(sCC6_MANIFEST_PATH)
    Do: DoEvents: Loop Until Len(Dir(sCC6_MANIFEST_PATH))
    If GetModuleHandle(StrPtr(vbNullString)) <> WIN32_NULL Then
        With ACTCTX
            .cbSize = LenB(ACTCTX)
            .lpSource = StrPtr(sCC6_MANIFEST_PATH)
        End With
        hActCtx = CreateActCtx(ACTCTX)
        Call ActivateActCtx(hActCtx, ActCtxCookie)
        Call IsUserAnAdmin
        Call InitCommonControls
    End If
    
End Sub


Private Sub RemoveCurrentActCtx()

    Const WIN32_NULL = 0

    If ActCtxCookie <> WIN32_NULL Then
        Call DeactivateActCtx(DEACTIVATE_ACTCTX_FLAG_NORMAL, ActCtxCookie)
        Call ReleaseActCtx(hActCtx)
        Call Kill(sCC6_MANIFEST_PATH)
    End If
    
End Sub


Private Sub CreateTempManifest(ByVal FilePathName As String)

    Dim fNr As Integer
    ReDim Bytes(0 To 574) As Byte
    
    Bytes(0) = 60: Bytes(1) = 63: Bytes(2) = 120: Bytes(3) = 109: Bytes(4) = 108: Bytes(5) = 32: Bytes(6) = 118: Bytes(7) = 101: Bytes(8) = 114: Bytes(9) = 115: Bytes(10) = 105: Bytes(11) = 111: Bytes(12) = 110: Bytes(13) = 61: Bytes(14) = 34: Bytes(15) = 49: Bytes(16) = 46: Bytes(17) = 48: Bytes(18) = 34: Bytes(19) = 32: Bytes(20) = 101: Bytes(21) = 110: Bytes(22) = 99: Bytes(23) = 111: Bytes(24) = 100: Bytes(25) = 105: Bytes(26) = 110: Bytes(27) = 103: Bytes(28) = 61: Bytes(29) = 34
    Bytes(30) = 85: Bytes(31) = 84: Bytes(32) = 70: Bytes(33) = 45: Bytes(34) = 56: Bytes(35) = 34: Bytes(36) = 32: Bytes(37) = 115: Bytes(38) = 116: Bytes(39) = 97: Bytes(40) = 110: Bytes(41) = 100: Bytes(42) = 97: Bytes(43) = 108: Bytes(44) = 111: Bytes(45) = 110: Bytes(46) = 101: Bytes(47) = 61: Bytes(48) = 34: Bytes(49) = 121: Bytes(50) = 101: Bytes(51) = 115: Bytes(52) = 34: Bytes(53) = 63: Bytes(54) = 62: Bytes(55) = 13: Bytes(56) = 10: Bytes(57) = 60: Bytes(58) = 97: Bytes(59) = 115
    Bytes(60) = 115: Bytes(61) = 101: Bytes(62) = 109: Bytes(63) = 98: Bytes(64) = 108: Bytes(65) = 121: Bytes(66) = 32: Bytes(67) = 120: Bytes(68) = 109: Bytes(69) = 108: Bytes(70) = 110: Bytes(71) = 115: Bytes(72) = 61: Bytes(73) = 34: Bytes(74) = 117: Bytes(75) = 114: Bytes(76) = 110: Bytes(77) = 58: Bytes(78) = 115: Bytes(79) = 99: Bytes(80) = 104: Bytes(81) = 101: Bytes(82) = 109: Bytes(83) = 97: Bytes(84) = 115: Bytes(85) = 45: Bytes(86) = 109: Bytes(87) = 105: Bytes(88) = 99: Bytes(89) = 114
    Bytes(90) = 111: Bytes(91) = 115: Bytes(92) = 111: Bytes(93) = 102: Bytes(94) = 116: Bytes(95) = 45: Bytes(96) = 99: Bytes(97) = 111: Bytes(98) = 109: Bytes(99) = 58: Bytes(100) = 97: Bytes(101) = 115: Bytes(102) = 109: Bytes(103) = 46: Bytes(104) = 118: Bytes(105) = 49: Bytes(106) = 34: Bytes(107) = 32: Bytes(108) = 109: Bytes(109) = 97: Bytes(110) = 110: Bytes(111) = 105: Bytes(112) = 102: Bytes(113) = 101: Bytes(114) = 115: Bytes(115) = 116: Bytes(116) = 86: Bytes(117) = 101: Bytes(118) = 114: Bytes(119) = 115
    Bytes(120) = 105: Bytes(121) = 111: Bytes(122) = 110: Bytes(123) = 61: Bytes(124) = 34: Bytes(125) = 49: Bytes(126) = 46: Bytes(127) = 48: Bytes(128) = 34: Bytes(129) = 62: Bytes(130) = 13: Bytes(131) = 10: Bytes(132) = 60: Bytes(133) = 97: Bytes(134) = 115: Bytes(135) = 115: Bytes(136) = 101: Bytes(137) = 109: Bytes(138) = 98: Bytes(139) = 108: Bytes(140) = 121: Bytes(141) = 73: Bytes(142) = 100: Bytes(143) = 101: Bytes(144) = 110: Bytes(145) = 116: Bytes(146) = 105: Bytes(147) = 116: Bytes(148) = 121: Bytes(149) = 13
    Bytes(150) = 10: Bytes(151) = 118: Bytes(152) = 101: Bytes(153) = 114: Bytes(154) = 115: Bytes(155) = 105: Bytes(156) = 111: Bytes(157) = 110: Bytes(158) = 61: Bytes(159) = 34: Bytes(160) = 49: Bytes(161) = 46: Bytes(162) = 48: Bytes(163) = 46: Bytes(164) = 48: Bytes(165) = 46: Bytes(166) = 48: Bytes(167) = 34: Bytes(168) = 13: Bytes(169) = 10: Bytes(170) = 112: Bytes(171) = 114: Bytes(172) = 111: Bytes(173) = 99: Bytes(174) = 101: Bytes(175) = 115: Bytes(176) = 115: Bytes(177) = 111: Bytes(178) = 114: Bytes(179) = 65
    Bytes(180) = 114: Bytes(181) = 99: Bytes(182) = 104: Bytes(183) = 105: Bytes(184) = 116: Bytes(185) = 101: Bytes(186) = 99: Bytes(187) = 116: Bytes(188) = 117: Bytes(189) = 114: Bytes(190) = 101: Bytes(191) = 61: Bytes(192) = 34: Bytes(193) = 42: Bytes(194) = 34: Bytes(195) = 13: Bytes(196) = 10: Bytes(197) = 110: Bytes(198) = 97: Bytes(199) = 109: Bytes(200) = 101: Bytes(201) = 61: Bytes(202) = 34: Bytes(203) = 67: Bytes(204) = 111: Bytes(205) = 109: Bytes(206) = 112: Bytes(207) = 97: Bytes(208) = 110: Bytes(209) = 121
    Bytes(210) = 78: Bytes(211) = 97: Bytes(212) = 109: Bytes(213) = 101: Bytes(214) = 46: Bytes(215) = 80: Bytes(216) = 114: Bytes(217) = 111: Bytes(218) = 100: Bytes(219) = 117: Bytes(220) = 99: Bytes(221) = 116: Bytes(222) = 78: Bytes(223) = 97: Bytes(224) = 109: Bytes(225) = 101: Bytes(226) = 46: Bytes(227) = 89: Bytes(228) = 111: Bytes(229) = 117: Bytes(230) = 114: Bytes(231) = 65: Bytes(232) = 112: Bytes(233) = 112: Bytes(234) = 34: Bytes(235) = 13: Bytes(236) = 10: Bytes(237) = 116: Bytes(238) = 121: Bytes(239) = 112
    Bytes(240) = 101: Bytes(241) = 61: Bytes(242) = 34: Bytes(243) = 119: Bytes(244) = 105: Bytes(245) = 110: Bytes(246) = 51: Bytes(247) = 50: Bytes(248) = 34: Bytes(249) = 13: Bytes(250) = 10: Bytes(251) = 47: Bytes(252) = 62: Bytes(253) = 13: Bytes(254) = 10: Bytes(255) = 60: Bytes(256) = 100: Bytes(257) = 101: Bytes(258) = 115: Bytes(259) = 99: Bytes(260) = 114: Bytes(261) = 105: Bytes(262) = 112: Bytes(263) = 116: Bytes(264) = 105: Bytes(265) = 111: Bytes(266) = 110: Bytes(267) = 62: Bytes(268) = 89: Bytes(269) = 111
    Bytes(270) = 117: Bytes(271) = 114: Bytes(272) = 32: Bytes(273) = 97: Bytes(274) = 112: Bytes(275) = 112: Bytes(276) = 108: Bytes(277) = 105: Bytes(278) = 99: Bytes(279) = 97: Bytes(280) = 116: Bytes(281) = 105: Bytes(282) = 111: Bytes(283) = 110: Bytes(284) = 32: Bytes(285) = 100: Bytes(286) = 101: Bytes(287) = 115: Bytes(288) = 99: Bytes(289) = 114: Bytes(290) = 105: Bytes(291) = 112: Bytes(292) = 116: Bytes(293) = 105: Bytes(294) = 111: Bytes(295) = 110: Bytes(296) = 32: Bytes(297) = 104: Bytes(298) = 101: Bytes(299) = 114
    Bytes(300) = 101: Bytes(301) = 46: Bytes(302) = 60: Bytes(303) = 47: Bytes(304) = 100: Bytes(305) = 101: Bytes(306) = 115: Bytes(307) = 99: Bytes(308) = 114: Bytes(309) = 105: Bytes(310) = 112: Bytes(311) = 116: Bytes(312) = 105: Bytes(313) = 111: Bytes(314) = 110: Bytes(315) = 62: Bytes(316) = 13: Bytes(317) = 10: Bytes(318) = 60: Bytes(319) = 100: Bytes(320) = 101: Bytes(321) = 112: Bytes(322) = 101: Bytes(323) = 110: Bytes(324) = 100: Bytes(325) = 101: Bytes(326) = 110: Bytes(327) = 99: Bytes(328) = 121: Bytes(329) = 62
    Bytes(330) = 13: Bytes(331) = 10: Bytes(332) = 60: Bytes(333) = 100: Bytes(334) = 101: Bytes(335) = 112: Bytes(336) = 101: Bytes(337) = 110: Bytes(338) = 100: Bytes(339) = 101: Bytes(340) = 110: Bytes(341) = 116: Bytes(342) = 65: Bytes(343) = 115: Bytes(344) = 115: Bytes(345) = 101: Bytes(346) = 109: Bytes(347) = 98: Bytes(348) = 108: Bytes(349) = 121: Bytes(350) = 62: Bytes(351) = 13: Bytes(352) = 10: Bytes(353) = 60: Bytes(354) = 97: Bytes(355) = 115: Bytes(356) = 115: Bytes(357) = 101: Bytes(358) = 109: Bytes(359) = 98
    Bytes(360) = 108: Bytes(361) = 121: Bytes(362) = 73: Bytes(363) = 100: Bytes(364) = 101: Bytes(365) = 110: Bytes(366) = 116: Bytes(367) = 105: Bytes(368) = 116: Bytes(369) = 121: Bytes(370) = 13: Bytes(371) = 10: Bytes(372) = 116: Bytes(373) = 121: Bytes(374) = 112: Bytes(375) = 101: Bytes(376) = 61: Bytes(377) = 34: Bytes(378) = 119: Bytes(379) = 105: Bytes(380) = 110: Bytes(381) = 51: Bytes(382) = 50: Bytes(383) = 34: Bytes(384) = 13: Bytes(385) = 10: Bytes(386) = 110: Bytes(387) = 97: Bytes(388) = 109: Bytes(389) = 101
    Bytes(390) = 61: Bytes(391) = 34: Bytes(392) = 77: Bytes(393) = 105: Bytes(394) = 99: Bytes(395) = 114: Bytes(396) = 111: Bytes(397) = 115: Bytes(398) = 111: Bytes(399) = 102: Bytes(400) = 116: Bytes(401) = 46: Bytes(402) = 87: Bytes(403) = 105: Bytes(404) = 110: Bytes(405) = 100: Bytes(406) = 111: Bytes(407) = 119: Bytes(408) = 115: Bytes(409) = 46: Bytes(410) = 67: Bytes(411) = 111: Bytes(412) = 109: Bytes(413) = 109: Bytes(414) = 111: Bytes(415) = 110: Bytes(416) = 45: Bytes(417) = 67: Bytes(418) = 111: Bytes(419) = 110
    Bytes(420) = 116: Bytes(421) = 114: Bytes(422) = 111: Bytes(423) = 108: Bytes(424) = 115: Bytes(425) = 34: Bytes(426) = 13: Bytes(427) = 10: Bytes(428) = 118: Bytes(429) = 101: Bytes(430) = 114: Bytes(431) = 115: Bytes(432) = 105: Bytes(433) = 111: Bytes(434) = 110: Bytes(435) = 61: Bytes(436) = 34: Bytes(437) = 54: Bytes(438) = 46: Bytes(439) = 48: Bytes(440) = 46: Bytes(441) = 48: Bytes(442) = 46: Bytes(443) = 48: Bytes(444) = 34: Bytes(445) = 13: Bytes(446) = 10: Bytes(447) = 112: Bytes(448) = 114: Bytes(449) = 111
    Bytes(450) = 99: Bytes(451) = 101: Bytes(452) = 115: Bytes(453) = 115: Bytes(454) = 111: Bytes(455) = 114: Bytes(456) = 65: Bytes(457) = 114: Bytes(458) = 99: Bytes(459) = 104: Bytes(460) = 105: Bytes(461) = 116: Bytes(462) = 101: Bytes(463) = 99: Bytes(464) = 116: Bytes(465) = 117: Bytes(466) = 114: Bytes(467) = 101: Bytes(468) = 61: Bytes(469) = 34: Bytes(470) = 42: Bytes(471) = 34: Bytes(472) = 13: Bytes(473) = 10: Bytes(474) = 112: Bytes(475) = 117: Bytes(476) = 98: Bytes(477) = 108: Bytes(478) = 105: Bytes(479) = 99
    Bytes(480) = 75: Bytes(481) = 101: Bytes(482) = 121: Bytes(483) = 84: Bytes(484) = 111: Bytes(485) = 107: Bytes(486) = 101: Bytes(487) = 110: Bytes(488) = 61: Bytes(489) = 34: Bytes(490) = 54: Bytes(491) = 53: Bytes(492) = 57: Bytes(493) = 53: Bytes(494) = 98: Bytes(495) = 54: Bytes(496) = 52: Bytes(497) = 49: Bytes(498) = 52: Bytes(499) = 52: Bytes(500) = 99: Bytes(501) = 99: Bytes(502) = 102: Bytes(503) = 49: Bytes(504) = 100: Bytes(505) = 102: Bytes(506) = 34: Bytes(507) = 13: Bytes(508) = 10: Bytes(509) = 108
    Bytes(510) = 97: Bytes(511) = 110: Bytes(512) = 103: Bytes(513) = 117: Bytes(514) = 97: Bytes(515) = 103: Bytes(516) = 101: Bytes(517) = 61: Bytes(518) = 34: Bytes(519) = 42: Bytes(520) = 34: Bytes(521) = 13: Bytes(522) = 10: Bytes(523) = 47: Bytes(524) = 62: Bytes(525) = 13: Bytes(526) = 10: Bytes(527) = 60: Bytes(528) = 47: Bytes(529) = 100: Bytes(530) = 101: Bytes(531) = 112: Bytes(532) = 101: Bytes(533) = 110: Bytes(534) = 100: Bytes(535) = 101: Bytes(536) = 110: Bytes(537) = 116: Bytes(538) = 65: Bytes(539) = 115
    Bytes(540) = 115: Bytes(541) = 101: Bytes(542) = 109: Bytes(543) = 98: Bytes(544) = 108: Bytes(545) = 121: Bytes(546) = 62: Bytes(547) = 13: Bytes(548) = 10: Bytes(549) = 60: Bytes(550) = 47: Bytes(551) = 100: Bytes(552) = 101: Bytes(553) = 112: Bytes(554) = 101: Bytes(555) = 110: Bytes(556) = 100: Bytes(557) = 101: Bytes(558) = 110: Bytes(559) = 99: Bytes(560) = 121: Bytes(561) = 62: Bytes(562) = 13: Bytes(563) = 10: Bytes(564) = 60: Bytes(565) = 47: Bytes(566) = 97: Bytes(567) = 115: Bytes(568) = 115: Bytes(569) = 101
    Bytes(570) = 109: Bytes(571) = 98: Bytes(572) = 108: Bytes(573) = 121: Bytes(574) = 62:
    
    fNr = FreeFile()
    Open FilePathName For Binary As #fNr
        Put #fNr, 1, Bytes
    Close #fNr
    
End Sub

2- Code Usage example:

VBA Code:

Option Explicit

Sub Test()

    Const PROMPT = "This is a demonstration on how to insert multiple Hyperlinks into a standard vba MsgBox." & vbNewLine & vbNewLine & _
    "Each marked-up text is associated with a corresponding Hyperlink target." & vbNewLine & vbNewLine & _
    "You can link to any files and folders such as C:\Drive or calc.exe or to urls such as MrExcel or the most used search engine 'Google'." & vbNewLine & vbNewLine & _
    "You must set up the text-link associations in a 2D string array before passing the array to the 'HyperlinkMsgBox' custom function." & vbNewLine & vbNewLine & _
    "Published @ MrExcel"
   
    Const TITLE = "Hello EXCEL/VBA/ world ! "
    Const BUTTONS = vbInformation
   
    Dim lRet As VbMsgBoxResult
    Dim sLinksArray(0 To 3, 1) As String
   
    sLinksArray(0, 0) = "MrExcel":            sLinksArray(0, 1) = "www.Mrexcel.com"
    sLinksArray(1, 0) = "C:\Drive":                   sLinksArray(1, 1) = "C:\"
    sLinksArray(2, 0) = "calc.exe":          sLinksArray(2, 1) = "Calc.exe"
    sLinksArray(3, 0) = "Google":             sLinksArray(3, 1) = "www.Google.com"

    lRet = HyperlinkMsgBox(PROMPT, sLinksArray, BUTTONS, TITLE)

End Sub

Any issues or feedback are welcome.

johnnyL · Jul 1, 2021

Looks very cool @Jaafar Tribak !

Jaafar Tribak · Jul 1, 2021

johnnyL said:
Looks very cool @Jaafar Tribak !

Thanks for the feedback

johnnyL · Jul 1, 2021

@Jaafar Tribak I played with your script a bit and I replaced:

VBA Code:

        Option Explicit

Sub Test()

Const PROMPT = "This is a demonstration on how to insert multiple Hyperlinks into a standard vba MsgBox." & vbNewLine & vbNewLine & _
"Each marked-up text is associated with a corresponding Hyperlink target." & vbNewLine & vbNewLine & _
"You can link to any files and folders such as C:\Drive or calc.exe or to urls such as MrExcel or the most used search engine 'Google'." & vbNewLine & vbNewLine & _
"You must set up the text-link associations in a 2D string array before passing the array to the 'HyperlinkMsgBox' custom function." & vbNewLine & vbNewLine & _
"Published @ MrExcel"
   
Const TITLE = "Hello EXCEL/VBA/ world ! "
Const BUTTONS = vbInformation
   
Dim lRet As VbMsgBoxResult
Dim sLinksArray(0 To 3, 1) As String
   
sLinksArray(0, 0) = "MrExcel":            sLinksArray(0, 1) = "www.Mrexcel.com"
sLinksArray(1, 0) = "C:\Drive":                   sLinksArray(1, 1) = "C:\"
sLinksArray(2, 0) = "calc.exe":          sLinksArray(2, 1) = "Calc.exe"
sLinksArray(3, 0) = "Google":             sLinksArray(3, 1) = "www.Google.com"

lRet = HyperlinkMsgBox(PROMPT, sLinksArray, BUTTONS, TITLE)

End Sub

With the following:

VBA Code:

        Option Explicit

Sub Test()

    Const PROMPT = "A demonstration of how to insert multiple Hyperlinks into a standard vba MsgBox." & vbNewLine & vbNewLine & _
    "You can link to drives/folders/programs/urls (Use your Imagination) via a MsgBox such as:" & vbNewLine & vbNewLine & _
    "C:\" & vbNewLine & _
    "Calculator" & vbNewLine & _
    "Command Promt" & vbNewLine & _
    "Notepad" & vbNewLine & _
    "Paint" & vbNewLine & _
    "Wordpad" & vbNewLine & _
    "MrExcel" & vbNewLine & _
    "Google" & vbNewLine & vbNewLine & vbNewLine & _
    "You must set up the text-link associations in a 2D string array before passing the array to the 'HyperlinkMsgBox' custom function." & vbNewLine & vbNewLine & vbNewLine & _
    "Published @ MrExcel"
    
    Const TITLE = "                            !!! Jaafar Tribak Productions Proudly Presents !!!"
    Const BUTTONS = vbInformation
'    "or the most used search engine 'Google'." & vbNewLine & vbNewLine & _

    Dim lRet As VbMsgBoxResult
    Dim sLinksArray(0 To 7, 1) As String
    
    sLinksArray(0, 0) = "MrExcel":          sLinksArray(0, 1) = "www.Mrexcel.com"
    sLinksArray(1, 0) = "C:\":              sLinksArray(1, 1) = "C:\"
    sLinksArray(2, 0) = "Calculator":       sLinksArray(2, 1) = "Calc.exe"
    sLinksArray(3, 0) = "Command Promt":    sLinksArray(3, 1) = "Cmd.exe"
    sLinksArray(4, 0) = "Notepad":          sLinksArray(4, 1) = "Notepad.exe"
    sLinksArray(5, 0) = "Paint":            sLinksArray(5, 1) = "mspaint.exe"
    sLinksArray(6, 0) = "Wordpad":          sLinksArray(6, 1) = "Wordpad.exe"
    sLinksArray(7, 0) = "Google":           sLinksArray(7, 1) = "www.Google.com"

    lRet = HyperlinkMsgBox(PROMPT, sLinksArray, BUTTONS, TITLE)

End Sub

Let me know what you think!

Jaafar Tribak · Jul 2, 2021

johnnyL said:
Let me know what you think!

That looks good and well put together !

Your implementation better illustrates the use of the code.

Thanks for your interest in this topic.

Dan_W · Jul 6, 2021

Hi Jaafar - I have checked both workbooks, and they both work perfectly - thank you. I will add this to my collection of your messagebox-related code!

For your reference, I use Office 365 64bit + Windows 10.

Jaafar Tribak · Jul 6, 2021

Dan_W said:
Hi Jaafar - I have checked both workbooks, and they both work perfectly - thank you. I will add this to my collection of your messagebox-related code!

For your reference, I use Office 365 64bit + Windows 10.

Thanks for confirming that it works

kamranyd · Jul 11, 2021

VBA Code:

dim fname as string

fname = Application.WorksheetFunction.Text(Range("B10"), "0000") & ".pdf"

Const Prompt = "Q. Number [-]> " & fname & " <[-]" & vbNewLine & _
    "Has been submitted to Database" & vbNewLine & _
    "PDF File saved in D:\Data>FILE>KYD A.C>QNT" & vbNewLine & _
    "Click to explore folder location C:\Users\KYD-PC\Desktop\"
  
    Const TITLE = "Al-Maliki Mechanical Engineering"
    Const BUTTONS = vbInformation
           
    Dim lRet As VbMsgBoxResult
    Dim sLinksArray(0 To 0, 1) As String
  
    sLinksArray(0, 0) = "C:\Users\KYD-PC\Desktop\":            sLinksArray(0, 1) = "C:\Users\KYD-PC\Desktop\"

    lRet = HyperlinkMsgBox(Prompt, fname, sLinksArray, BUTTONS, TITLE)

these codes give constant expression required and highlight "& fname &" words. i want show cell value in message box. Please need help how to sort out this error.

GWteB · Jul 11, 2021

The HyperlinkMsgBox procedure has four (!!) dependencies. You're trying to inject five arguments whilst the second one is of a not expected memory type. You really should take a look at the usage example of Jaafar's post #12.

Putting an Hyperlink in a MsgBox !!

Jaafar Tribak

Well-known Member

tubrak

Board Regular

Excel Facts

Jaafar Tribak

Well-known Member

johnnyL

Well-known Member

Jaafar Tribak

Well-known Member

johnnyL

Well-known Member

Attachments

Jaafar Tribak

Well-known Member

Dan_W

Well-known Member

Jaafar Tribak

Well-known Member

kamranyd

Board Regular

GWteB

Well-known Member

Similar threads

Forum statistics

Share this page

Putting an Hyperlink in a MsgBox !!

Well-known Member

Board Regular

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Attachments

Well-known Member

Well-known Member

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock