Putting an Hyperlink in a MsgBox !!

[Jaafar Tribak]

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 :

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:

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:

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.

 

[kamranyd]

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

message box with hyperlink show fine but I want to show whatever cell has value it get shown in message box as text. can you help how to make these codes work.

 

[GWteB]

Usage of the blue marked variable is correct. Usage of the red marked one is not, you should leave that one out.

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)

 

[kamranyd]

Usage of the blue marked variable is correct. Usage of the red marked one is not, you should leave that one out.

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)

yes i did that, but it give compile error that constant expression required. i use "fname" because it should give me cell value in message box. for example that B10 cell has this value. hope you understood. if i use simple message box it show me no error. but i want this type codes which show cell value and clickable link

 

[GWteB]

I see. You're mixing constants and variables, but that can only go in one direction. At compile time VBA doesn't know the contents of the variable fname, giving you a compile error.
Try ...

dim fname as string, Prompt as string

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

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\"

 

[kamranyd]

I see. You're mixing constants and variables, but that can only go in one direction. At compile time VBA doesn't know the contents of the variable fname, giving you a compile error.
Try ...

dim fname as string, Prompt 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\"
[/CO
[/QUOTE]

Now working. Thnx so much.

 

[Biz]

This is bloodly awesome m8. Keep up the good work.

 

[kamranyd]

VBA Code:

dim fname as string, Prompt as string

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

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\"

can we change font style to bold and give color red to " & fname &". so it look more eye catchy and different from another text. i mean to say can we change font style and color in this prompt msg box.

 

[Jaafar Tribak]

can we change font style to bold and give color red to " & fname &". so it look more eye catchy and different from another text. i mean to say can we change font style and color in this prompt msg box.

Changing the font of individual letters\words in the text is difficult as opposed to changing the font of the entire text.

 

[kamranyd]

letters

so it mean it cant be done or there any other way.

 

[johnnyL]

so it mean it cant be done or there any other way.

Messing with Messagebox equates to messing with windows, so it is highly advised against.

A userform would be a much better alternative.