RobDog888
Apr 3rd, 2007, 09:40 PM
When you create custom Menu Items and Toolbar Buttons you may find yourself needing to associate a shortcut key or keypress sequence to invoke your custom click event. Using the RegisterHotkey API call as well as a few others you can make it work.
For ex: You added a custom menut item ...
"My Send Button (Ctl+Alt+S)"
When clicked, the menu will fire the click event when you set the .OnAction property of the menu item or sync up a WithEvents. The shortcut is different.
We use the RegisterHotKey API just as we would in any other programming language but we need a parent window handle and Outlook doesnt expose one to us from the Application object like it does in a few other Office Apps. Using the FindWindow API we can get the window handle and progress as usual.
The Application_MAPILogonComplete() event is where we need to start initializing. Then to clean up when Outlook closes we need to unhook the hotkey in the Application_Quit event.
Using this method and APIs we can assign shortcut keys or shortcut keypress sequences that can not be achieved in a menu editor.
For this example we will use "Ctl+Alt+S". This will also show that you can override the default shortcut hotkeys and replace them with your own event.
Outlook 2003 Or 2007 VBA:
'BEHIND CLASS MODULE: "ThisOutlookSession"
Option Explicit
'Copyright © 2007 by RobDog888 (VB/Office Guru™). All Rights reserved.
'
'Distribution: You can freely use this code in your own
' applications provided that this copyright
' is left unchanged, but you may not reproduce
' or publish this code on any web site, online
' service, or distribute as source on any
' media without express permission.
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type Msg
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function RegisterHotKey Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal id As Long, _
ByVal fsModifiers As Long, _
ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" ( _
ByVal hWnd As Long, _
ByVal id As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" ( _
lpMsg As Msg, _
ByVal hWnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private mbCancel As Boolean
Private lHwnd As Long
Private Sub ProcessMessages()
Dim Message As Msg
'LOOP UNTIL MBCANCEL IS TRUE
Do While Not bCancel
'WAIT FOR MESSAGE
WaitMessage
'CHECK IF ITS A HOTKEY MESSAGE
If PeekMessage(Message, lHwnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
'INVOKE THE SEND MACRO OF THE SELECTED ITEM
MsgBox "Ctl+Alt+S", vbOKOnly + vbInformation, "OD FAQ TEST"
End If
'RESUME THE OS PROCESSING OF OTHER MESSAGES
DoEvents
Loop
End Sub
Private Sub Application_MAPILogonComplete()
Dim ret As Long
mbCancel = False
Dim iBuild As Integer
'VERSION DETECTION FROM MY OUTLOOK FAQ:
'http://vbforums.com/showthread.php?t=402020
'GET THE MAJOR BUILD ONLY TO MAKE IT EASIER TO DETERMINE EXACT VERSION
iBuild = Left$(Application.Version, InStr(1, Application.Version, ".") + 1)
Select Case iBuild
Case 7 To 10
'sVersion = "97/98/2000/2002"
MsgBox "Too Old! Just kidding." & vbNewline & _
"I dont have the older versions to test with.", _
vbOkOnly + vbInformation, "[FAQ's: OD] Outlook HotKey"
Exit Sub
Case 11, 12
'sVersion = "2003/2007"
lHwnd = FindWindow("rctrl_renwnd32", "Inbox - Microsoft Outlook")
Case Else
MsgBox "Too New!"
Exit Sub
End Select
'NO NEED TO ERROR TRAP FOR THE OUTLOOK WINDOW SINCE THIS IS VBA CODE
lHwnd = FindWindow("rctrl_renwnd32", "Inbox - Microsoft Outlook")
'REGISTER THE HOTKEY SEQUENCE: Ctrl+Alt+S
ret = RegisterHotKey(lHwnd, &HBFFF&, MOD_CONTROL Or MOD_ALT, vbKeyS)
'PROCESS THE HOTKEY MESSAGES
ProcessMessages
End Sub
Private Sub Application_Quit()
mbCancel = True
'UNREGISTER HOTKEY
Call UnregisterHotKey(lHwnd, &HBFFF&)
End Sub
For ex: You added a custom menut item ...
"My Send Button (Ctl+Alt+S)"
When clicked, the menu will fire the click event when you set the .OnAction property of the menu item or sync up a WithEvents. The shortcut is different.
We use the RegisterHotKey API just as we would in any other programming language but we need a parent window handle and Outlook doesnt expose one to us from the Application object like it does in a few other Office Apps. Using the FindWindow API we can get the window handle and progress as usual.
The Application_MAPILogonComplete() event is where we need to start initializing. Then to clean up when Outlook closes we need to unhook the hotkey in the Application_Quit event.
Using this method and APIs we can assign shortcut keys or shortcut keypress sequences that can not be achieved in a menu editor.
For this example we will use "Ctl+Alt+S". This will also show that you can override the default shortcut hotkeys and replace them with your own event.
Outlook 2003 Or 2007 VBA:
'BEHIND CLASS MODULE: "ThisOutlookSession"
Option Explicit
'Copyright © 2007 by RobDog888 (VB/Office Guru™). All Rights reserved.
'
'Distribution: You can freely use this code in your own
' applications provided that this copyright
' is left unchanged, but you may not reproduce
' or publish this code on any web site, online
' service, or distribute as source on any
' media without express permission.
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type Msg
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function RegisterHotKey Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal id As Long, _
ByVal fsModifiers As Long, _
ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" ( _
ByVal hWnd As Long, _
ByVal id As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" ( _
lpMsg As Msg, _
ByVal hWnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private mbCancel As Boolean
Private lHwnd As Long
Private Sub ProcessMessages()
Dim Message As Msg
'LOOP UNTIL MBCANCEL IS TRUE
Do While Not bCancel
'WAIT FOR MESSAGE
WaitMessage
'CHECK IF ITS A HOTKEY MESSAGE
If PeekMessage(Message, lHwnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
'INVOKE THE SEND MACRO OF THE SELECTED ITEM
MsgBox "Ctl+Alt+S", vbOKOnly + vbInformation, "OD FAQ TEST"
End If
'RESUME THE OS PROCESSING OF OTHER MESSAGES
DoEvents
Loop
End Sub
Private Sub Application_MAPILogonComplete()
Dim ret As Long
mbCancel = False
Dim iBuild As Integer
'VERSION DETECTION FROM MY OUTLOOK FAQ:
'http://vbforums.com/showthread.php?t=402020
'GET THE MAJOR BUILD ONLY TO MAKE IT EASIER TO DETERMINE EXACT VERSION
iBuild = Left$(Application.Version, InStr(1, Application.Version, ".") + 1)
Select Case iBuild
Case 7 To 10
'sVersion = "97/98/2000/2002"
MsgBox "Too Old! Just kidding." & vbNewline & _
"I dont have the older versions to test with.", _
vbOkOnly + vbInformation, "[FAQ's: OD] Outlook HotKey"
Exit Sub
Case 11, 12
'sVersion = "2003/2007"
lHwnd = FindWindow("rctrl_renwnd32", "Inbox - Microsoft Outlook")
Case Else
MsgBox "Too New!"
Exit Sub
End Select
'NO NEED TO ERROR TRAP FOR THE OUTLOOK WINDOW SINCE THIS IS VBA CODE
lHwnd = FindWindow("rctrl_renwnd32", "Inbox - Microsoft Outlook")
'REGISTER THE HOTKEY SEQUENCE: Ctrl+Alt+S
ret = RegisterHotKey(lHwnd, &HBFFF&, MOD_CONTROL Or MOD_ALT, vbKeyS)
'PROCESS THE HOTKEY MESSAGES
ProcessMessages
End Sub
Private Sub Application_Quit()
mbCancel = True
'UNREGISTER HOTKEY
Call UnregisterHotKey(lHwnd, &HBFFF&)
End Sub