The code below is a replacement for MsgBox that is Unicode, runs on VB5/VB6 and all versions of VBA including 64-bit as in 64-bit Office 2010 and later. It uses an undocumented function for an optional timeout period that has been around since XP (theoretically it could go away but unlikely since it is still in as of 8.1). Since the main function uses "Wide" (Unicode) characters, I call the function MsgBoxW instead of VB's MsgBox.
The code checks the OS version and if it is earlier than XP it uses the standard MessageBox call (the same one VB/VBA MsgBox uses) instead of the undocumented call with timeout. the timeout period is optional and is entered in milliseconds (1000ms = 1sec). If you specify 0 for the timeout period then the message box remains onscreen until the user deals with it with the keyboard or mouse.
If a timeout period is specified and the timeout period is reached, the function returns with a value of vbTimedOut, defined as 32000 (I didn't pick this, the Windows designers did...).
I also threw in some other simple things. I used conditional compilation to set a constant at compile time for the number of bits of the program (not the OS). This variable is called NumBits and will be either 32 or 64.
When the MsgBoxW function is called, it will check to see if the Windows version has been determined via the Init sub and if not it will call Init. In that routine, the OS major version and minor versions are combined into the public variable OSVersion. To keep the code simple we use MajorVersion x 100 plus the MinorVersion. For example, Windows XP has a MajorVersion of 5 and a MinorVersion of 01 so OSVersion will be 501.
The OS Build number is saved into the public variable OSBuild.
the operating system bits (32 or 64) are found by examining the environment variable string "ProgramFiles(x86)". Windows does not have this environment variable in the 32-bit versions, only the 64-bit versions so we test for the length of the return variable.
Note that the Windows API functions want a handle passed to them so we have to figure out at compile time whether we are in 32 or 64-bit VB/VBA and set the size of the window handle accordingly. That's why you will see two function headers for MsgBoxW. Actually only one is used as determined by whether the compiler finds the conditional compilation constant VBA7 which only is found in Office 2010 and later VBA and if so, the code specifies the variable type of the window handle "hwnd" as a LongPtr. Office is smart enough to figure out internally whether the code is 32 or 64-bit and make the window handle 32 or 64 bit.
Likewise we have to have two sets of API declarations at the top of the code module, one for "traditional" 32-bit code including VB5 and 6 and one for the new Office VBA variables where we have to use LongPtr instead of Long where appropriate.
Also, in order to make the API calls Unicode instead of ANSI, we don't pass the MsgBox text or caption strings to the API calls as String but rather as pointers like StrPtr(theString) so VB won't do its conversion from native Unicode to ANSI. We als make the API calls that need these pointers use passed variables as ByVal instead of ByRef to get the pointer passed instead of an address to a pointer.
Comments?
The code checks the OS version and if it is earlier than XP it uses the standard MessageBox call (the same one VB/VBA MsgBox uses) instead of the undocumented call with timeout. the timeout period is optional and is entered in milliseconds (1000ms = 1sec). If you specify 0 for the timeout period then the message box remains onscreen until the user deals with it with the keyboard or mouse.
If a timeout period is specified and the timeout period is reached, the function returns with a value of vbTimedOut, defined as 32000 (I didn't pick this, the Windows designers did...).
I also threw in some other simple things. I used conditional compilation to set a constant at compile time for the number of bits of the program (not the OS). This variable is called NumBits and will be either 32 or 64.
When the MsgBoxW function is called, it will check to see if the Windows version has been determined via the Init sub and if not it will call Init. In that routine, the OS major version and minor versions are combined into the public variable OSVersion. To keep the code simple we use MajorVersion x 100 plus the MinorVersion. For example, Windows XP has a MajorVersion of 5 and a MinorVersion of 01 so OSVersion will be 501.
The OS Build number is saved into the public variable OSBuild.
the operating system bits (32 or 64) are found by examining the environment variable string "ProgramFiles(x86)". Windows does not have this environment variable in the 32-bit versions, only the 64-bit versions so we test for the length of the return variable.
Note that the Windows API functions want a handle passed to them so we have to figure out at compile time whether we are in 32 or 64-bit VB/VBA and set the size of the window handle accordingly. That's why you will see two function headers for MsgBoxW. Actually only one is used as determined by whether the compiler finds the conditional compilation constant VBA7 which only is found in Office 2010 and later VBA and if so, the code specifies the variable type of the window handle "hwnd" as a LongPtr. Office is smart enough to figure out internally whether the code is 32 or 64-bit and make the window handle 32 or 64 bit.
Likewise we have to have two sets of API declarations at the top of the code module, one for "traditional" 32-bit code including VB5 and 6 and one for the new Office VBA variables where we have to use LongPtr instead of Long where appropriate.
Also, in order to make the API calls Unicode instead of ANSI, we don't pass the MsgBox text or caption strings to the API calls as String but rather as pointers like StrPtr(theString) so VB won't do its conversion from native Unicode to ANSI. We als make the API calls that need these pointers use passed variables as ByVal instead of ByRef to get the pointer passed instead of an address to a pointer.
Code:
Private Type OSVERSIONINFO
' used by API call GetVersionExW
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion(1 To 256) As Byte
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetVersionExW Lib "kernel32" (lpOSVersinoInfo As OSVERSIONINFO) As Long
' http://msdn.microsoft.com/en-us/library/ms724451%28VS.85%29.aspx
Private Declare PtrSafe Function MessageBoxW Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal PromptPtr As LongPtr, _
ByVal TitlePtr As LongPtr, _
ByVal UType As VbMsgBoxStyle) _
As VbMsgBoxResult
' http://msdn.microsoft.com/en-us/library/ms645505(VS.85).aspx
Private Declare PtrSafe Function MessageBoxTimeoutW Lib "user32.dll" ( _
ByVal WindowHandle As LongPtr, _
ByVal PromptPtr As LongPtr, _
ByVal TitlePtr As LongPtr, _
ByVal UType As VbMsgBoxStyle, _
ByVal Language As Integer, _
ByVal Miliseconds As Long _
) As VbMsgBoxResult
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms645507(v=vs.85).aspx (XP+, undocumented)
#Else
' for Office before 2010 and also VB6
Private Declare Function GetVersionExW Lib "kernel32" (lpOSVersinoInfo As OSVERSIONINFO) As Long
Private Declare Function MessageBoxW Lib "user32.dll" (ByVal hwnd As Long, ByVal PromptPtr As Long, _
ByVal TitlePtr As Long, ByVal UType As VbMsgBoxStyle) As VbMsgBoxResult
Private Declare Function MessageBoxTimeoutW Lib "user32.dll" (ByVal HandlePtr As Long, _
ByVal PromptPtr As Long, ByVal TitlePtr As Long, ByVal UType As VbMsgBoxStyle, _
ByVal Language As Integer, ByVal Miliseconds As Long) As VbMsgBoxResult
#End If
Public Const vbTimedOut As Long = 32000 ' return if MsgBoxW times out
Public OSVersion As Long
Public OSBuild As Long
Public OSBits As Long
' NumBits will be 32 if the VB/VBA system running this code is 32-bit. VB6 is always 32-bit
' and all versions of MS Office up until Office 2010 are 32-bit. Office 2010+ can be installed
' as either 32 or 64-bit
#If Win64 Then
Public Const NumBits As Byte = 64
#Else
Public Const NumBits As Byte = 32
#End If
Sub Init()
' Sets the operating system major version * 100 plus the Minor version in a long
' Ex- Windows Xp has major version = 5 and the minor version equal to 01 so the return is 501
Dim version_info As OSVERSIONINFO
OSBuild = 0
version_info.dwOSVersionInfoSize = LenB(version_info) '276
If GetVersionExW(version_info) = 0 Then
OSVersion = -1 ' error of some sort. Shouldn't happen.
Else
OSVersion = (version_info.dwMajorVersion * 100) + version_info.dwMinorVersion
If version_info.dwPlatformId = 0 Then
OSVersion = 301 ' Win 3.1
Else
OSBuild = version_info.dwBuildNumber
End If
End If
' Sets OSBits=64 if running on a 64-bit OS, 32 if on a 32-bit OS. NOTE- This is not the
' # bits of the program executing the program. 32-bit OFFice or VBA6 would return
' OSBits = 64 if the code is running on a machine that has is running 64-bit Windows.
If Len(Environ$("PROGRAMFILES(X86)")) > 0 Then OSBits = 64 Else OSBits = 32 ' can't be 16
End Sub
#If VBA7 Then
Public Function MsgBoxW( _
Optional Prompt As String = "", _
Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title As String = "", _
Optional ByVal TimeOutMSec As Long = 0, _
Optional flags As Long = 0, _
Optional ByVal hwnd As LongPtr = 0) As VbMsgBoxResult
#Else
Public Function MsgBoxW( _
Optional Prompt As String = "", _
Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title As String = "", _
Optional ByVal TimeOutMSec As Long = 0, _
Optional flags As Long = 0, _
Optional ByVal hwnd As Long = 0) As VbMsgBoxResult
#End If
' A UniCode replacement for MsgBox with optional Timeout
' Returns are the same as for VB/VBA's MsgBox call except
' If there is an error (unlikely) the error code is returned as a negative value
' If you specify a timeout number of milliseconds and the time elapses without
' the user clicking a button or pressing Enter, the return is "vbTimedOut" (numeric value = 32000)
' Inuts are the same as for the VB/VBA version except for the added in;ut variable
' TimeOutMSec which defaults to 0 (infinite time) but specifies a time that if the
' message box is displayed for that long it will automatically close and return "vbTimedOut"
' NOTE- The time out feature was added in Windows XP so it is ignored if you run this
' code on Windows 2000 or earlier.
' NOTE- The time out feature uses an undocumented feature of Windows and is not guaranteed
' to be in future versions of Windows although it has been in all since XP.
If OSVersion < 600 Then ' WindowsVersion less then Vista
Init
If OSVersion < 600 Then ' earlier than Vista
If (Buttons And 15) = vbAbortRetryIgnore Then Buttons = (Buttons And 2147483632) Or 6 ' (7FFFFFFF xor 15) or 6
End If
End If
If (OSVersion >= 501) And (TimeOutMSec > 0) Then ' XP and later only
MsgBoxW = MessageBoxTimeoutW(hwnd, StrPtr(Prompt), StrPtr(Title), Buttons Or flags, 0, TimeOutMSec)
Else ' earlier than XP does not have timeout capability for MessageBox
MsgBoxW = MessageBoxW(hwnd, StrPtr(Prompt), StrPtr(Title), Buttons Or flags)
End If
If MsgBoxW = 0 Then MsgBoxW = Err.LastDllError ' this should never happen
End Function
