Jaafar Tribak
Well-known Member
- Joined
- Dec 5, 2002
- Messages
- 9,779
- Office Version
- 2016
- Platform
- Windows
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 :
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:
2- Code usage examples:
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.
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.
Last edited: