Option Explicit

Private Type CWPSTRUCT
       lParam As Long
       wParam As Long
       message As Long
       hwnd As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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 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 Const WH_CALLWNDPROC = 4
Private Const GWL_WNDPROC = (-4)
Private Const WM_CTLCOLORBTN = &H135
Private Const WM_DESTROY = &H2
Private Const WM_SETTEXT = &HC
Private Const WM_CREATE = &H1

Private lHook As Long
Private lPrevWnd As Long

Private bCustom As Boolean
Private sButtons() As String
Private lButton As Long
Private sHwnd As String

Public Function SubMsgBox(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim sText As String
   
   Select Case Msg
   Case WM_CTLCOLORBTN
       'Customize the MessageBox Buttons if neccessary..
       'First Process the Default Action of the Message (Draw the Button)
       SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
       'Now Change the Button Text if Required
       If Not bCustom Then Exit Function
       If lButton = 0 Then sHwnd = ""
       'If this Button has Been Modified Already then Exit
       If InStr(sHwnd, " " & Trim(Str(lParam)) & " ") Then Exit Function
       sText = sButtons(lButton)
       sHwnd = sHwnd & " " & Trim(Str(lParam)) & " "
       lButton = lButton + 1
       'Modify the Button Text
       SendMessage lParam, WM_SETTEXT, Len(sText), ByVal sText
       Exit Function
       
   Case WM_DESTROY
       'Remove the MsgBox Subclassing
       Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd)
   End Select
   SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
End Function

Private Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim tCWP As CWPSTRUCT
   Dim sClass As String
   'This is where you need to Hook the Messagebox
   CopyMemory tCWP, ByVal lParam, Len(tCWP)
   If tCWP.message = WM_CREATE Then
       sClass = Space(255)
       sClass = Left(sClass, GetClassName(tCWP.hwnd, ByVal sClass, 255))
       If sClass = "#32770" Then
           'Subclass the Messagebox as it's created
           lPrevWnd = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubMsgBox)
       End If
   End If
   HookWindow = CallNextHookEx(lHook, nCode, wParam, ByVal lParam)
End Function

Public Function MsgBoxEx(ByVal Prompt As String, Optional ByVal Buttons As Long = vbOKOnly, Optional ByVal Title As String, Optional ByVal HelpFile As String, Optional ByVal Context As Long, Optional ByRef CustomButtons As Variant) As Long
   Dim lReturn As Long
   
   bCustom = (Buttons = vbCustom)
   If bCustom And IsMissing(CustomButtons) Then
       MsgBox "When using the Custom option you need to supply some Buttons in the ""CustomButtons"" Argument.", vbExclamation + vbOKOnly, "Error"
       Exit Function
   End If
   lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance, App.ThreadID)
   'Set the Defaults
   If Len(Title) = 0 Then Title = App.Title
   If bCustom Then
       'User wants to use own Button Titles..
       If TypeName(CustomButtons) = "String" Then
           ReDim sButtons(0)
           sButtons(0) = CustomButtons
           Buttons = 0
       Else
           sButtons = CustomButtons
           Buttons = UBound(sButtons)
       End If
   End If
   lButton = 0
   
   'Show the Modified MsgBox
   lReturn = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
   Call UnhookWindowsHookEx(lHook)
   'If it's a Custom Button MsgBox, Alter the Return Value
   If bCustom Then lReturn = lReturn - (UBound(CustomButtons) + 1)
   bCustom = False
   MsgBoxEx = lReturn
End Function

Dim aButtons(0) As String
   aButtons(0) = "Go"
z = aButtons(MsgBoxEx("Text", vbCustom, "Title", , , aButtons))