Option Explicit
#If VBA7 Then
Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare PtrSafe Function LockSetForegroundWindow Lib "user32.dll" (ByVal uLockCode As Long) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Declare Function LockSetForegroundWindow Lib "user32.dll" (ByVal uLockCode As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
Const LSFW_LOCK = 1
Const LSFW_UNLOCK = 2
Dim parent_handle&
Sub FndWndBUGS()
Dim ClassName$, x
' Window information
ClassName = "Oberon App"
' Find the correct window
parent_handle = FindWindowLike(GetDesktopWindow(), "WinBUGS14", ClassName)
If parent_handle <> 0 Then
SetForegroundWindow (parent_handle)
LockSetForegroundWindow (LSFW_LOCK)
End If
'Press Alt key down
keybd_event 18, &H9D, 0, 0
'Press the letter "M" then release
keybd_event 77, &H9D, 0, 0
keybd_event 77, &H9D, 2, 0
'Release the letter "C" then release
keybd_event 67, &H9D, 0, 0
keybd_event 67, &H9D, 2, 0
'Release the Alt key
keybd_event 18, &H9D, 2, 0
End Sub
Function FindWindowLike(hWndParent As Long, Caption As String, ClassName As String) As Long
On Error Resume Next
Dim hwnd&
Const GW_HWNDNEXT = 2, GW_CHILD = 5
' Find window using a like function
hwnd = GetWindow(hWndParent, GW_CHILD)
Do Until hwnd = 0
If WindowText(hwnd) Like "*" & Caption & "*" Then
FindWindowLike = hwnd
Exit Do
End If
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
DoEvents
Loop
End Function
Function WindowText(hwnd As Long) As String
On Error Resume Next
Dim lng&, str$
Const WM_GETTEXT = &HD, WM_GETTEXTLENGTH = &HE
' Convert ID to text
If hwnd <> 0 Then
lng = SendMessage(hwnd, WM_GETTEXTLENGTH, 0&, 0&) + 1
If lng > 0 Then
str = String$(lng, vbNullChar)
lng = SendMessage(hwnd, WM_GETTEXT, lng, ByVal str)
If lng > 0 Then WindowText = Left$(str, lng)
End If
End If
End Function
Function apicGetForegroundWindow()
' Return window handle of active window.
Dim lngWindow As Long
lngWindow = GetActiveWindow()
apicGetForegroundWindow = lngWindow
End Function
Hope this helps someone else.
Bookmarks