I'm trying to develop an 'auto run' macro to determine if the VBE is open (not necessarily the window of focus, just open). If this is TRUE then ... take some action.
If this macro is connected to a CommandButton it works but I can't get it to function anywhere in the ThisWorkbook:
Sub CloseVBE()
'use the MainWindow Property which represents
' the main window of the Visual Basic Editor - open the code window in VBE,
' but not the Project Explorer if it was closed previously:
If Application.VBE.MainWindow.Visible = True Then
MsgBox ""
'close VBE window:
Application.VBE.MainWindow.Visible = False
End If
End Sub
I was given the following FUNCTION to do the same but I can't get it to work either:
Option Explicit
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Const GW_HWNDNEXT = 2
Function VBE_IsOpen() As Boolean
Const appName As String = "Visual Basic for Applications"
Dim stringBuffer As String
Dim temphandle As Long
VBE_IsOpen = False
temphandle = FindWindow(vbNullString, vbNullString)
Do While temphandle <> 0
stringBuffer = String(GetWindowTextLength(temphandle) + 1, Chr$(0))
GetWindowText temphandle, stringBuffer, Len(stringBuffer)
stringBuffer = Left$(stringBuffer, Len(stringBuffer) - 1)
If InStr(1, stringBuffer, appName) > 0 Then
VBE_IsOpen = True
CloseVBE
End If
temphandle = GetWindow(temphandle, GW_HWNDNEXT)
Loop
End Function
1/23/2018 Here is an update to the original question:
I located the following code that performs EXACTLY as I was needing but when closing the workbook, the macro errors out on the line indicated:
Public Sub StopEventHook(lHook As Long)
Dim LRet As Long
Set lHook = 0'<<<------ When closing workbook, errors out on this line.
If lHook = 0 Then Exit Sub
LRet = UnhookWinEvent(lHook)
Exit Sub
End Sub
Here is the entire code, paste this into a regular Module:
Option Explicit
Private Const EVENT_SYSTEM_FOREGROUND = &H3&
Private Const WINEVENT_OUTOFCONTEXT = 0
Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, _
ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, _
ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private pRunningHandles As Collection
Public Function StartEventHook() As Long
If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection
StartEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
pRunningHandles.Add StartEventHook
End Function
Public Sub StopEventHook(lHook As Long)
Dim LRet As Long
On Error Resume Next
Set lHook = 0 '<<<------ When closing workbook, errors out on this line.
If lHook = 0 Then Exit Sub
LRet = UnhookWinEvent(lHook)
Exit Sub
End Sub
Public Sub StartHook()
StartEventHook
End Sub
Public Sub StopAllEventHooks()
Dim vHook As Variant, lHook As Long
For Each vHook In pRunningHandles
lHook = vHook
StopEventHook lHook
Next vHook
End Sub
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
'This function is a callback passed to the win32 api
'We CANNOT throw an error or break. Bad things will happen.
On Error Resume Next
Dim thePID As Long
If LEvent = EVENT_SYSTEM_FOREGROUND Then
GetWindowThreadProcessId hWnd, thePID
If thePID = GetCurrentProcessId Then
Application.OnTime Now, "Event_GotFocus"
Else
Application.OnTime Now, "Event_LostFocus"
End If
End If
On Error GoTo 0
End Function
Public Sub Event_GotFocus()
Sheet1.[A1] = "Got Focus"
End Sub
Public Sub Event_LostFocus()
Sheet1.[A1] = "Nope"
End Sub
Paste this into the ThisWorkbook :
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopAllEventHooks
End Sub
Private Sub Workbook_Open()
StartHook
End Sub
Good news: only two minor changes are required to get it to work fine on my system (Excel 2013 x86 on Win 8.1 x64):
Add the following declaration for UnhookWinEvent
at the top of the module:
Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal hHook As Long)
Set x=y
sets object variable x
to reference object instance y
. As a result, it cannot be used for Long
, String
, or other non-object types. That is why you get an Object Required
error when that line runs. Details of Set
are in the answers to this question.
Separately, I'm not sure where you got the code from, but the error line would make the StopEventHook
function a no-op if it worked:
Public Sub StopEventHook(lHook As Long)
Dim LRet As Long
On Error Resume Next
Set lHook = 0 '<<<- The error line --- throws away the input parameter!
If lHook = 0 Then Exit Sub ' ... then this always causes the Sub to exit.
LRet = UnhookWinEvent(lHook)
Exit Sub ' note: don't need this; you can remove it if you want.
End Sub
If lHook
did get set to 0, the next line would always cause the Sub
to exit, so the hook would never be unloaded.
Possible crash issue
Sometimes Excel crashes when I close the workbook, but not always. I actually don't think of that as a problem because I am used to hooks bringing down Office :) . However, @RossBush's comment that "you could be killing the hook chain by not calling CallNextHookEx() in your WinProc" may be part of the issue. If you run into that problem and can't figure out how to fix it, I would suggest asking a separate question. There are certainly plenty of folks who have encountered the same!
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With