通过VBA获取窗体句柄

Manrce

限于有限的办公环境，无法安装其他软件，一直想用自带的VBA多软件办公自动化。而要用vba操作不同的程序，首先要获取其句柄。本案例是在学习HOOK的知识中想到的，借鉴了一部分。
主要思路：
1、获取鼠标位置所在的窗口句柄
1.1、GetCursorPos获得鼠标位置
1.2、WindowFromPoint获取鼠标位置的句柄
2、通过按键反馈当前鼠标所在位置的句柄
2.1 SetWindowsHookEx通过hook拦截信息
2.2 WH_KEYBOARD_LL全局监控键盘操作
2.3 确定按键正确运行获取鼠标位置句柄

代码如下：

1. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
   
2. Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
   
3. Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
   
4. Public 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
   
5. Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
   
6. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
   
7. Public Const WH_KEYBOARD_LL = 13
   
8. Public Const WM_KEYDOWN = &H100
   
9. Public hHook As Long '定义钩子
   
10. Public nakey As EVENTMSG '定义键盘指令
    
11. Public windowshwnd As Long '定义Gethwnd获取的句柄
    
12. Public Type EVENTMSG '定义键盘返回类型
    
13.     vKey As Long
    
14.     sKey As Long
    
15.     flag As Long
    
16.     time As Long
    
17. End Type
    
18. Public Type POINTAPI '得到鼠标坐标类型GetCursorPos（POINTAPI）
    
19.         X As Long
    
20.         Y As Long
    
21. End Type
    
22. Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
23.     Dim a As String
    
24.     If ncode = 0 Then
    
25.         If wParam = WM_KEYDOWN Then
    
26.             CopyMemory nakey, ByVal lParam, LenB(nakey)
    
27.             a = Chr(nakey.vKey)
    
28.             If a = "E" Then
    
29.                 Call getwindowhwnd
    
30.                 Gethwnd.TextBox1.Value = windowshwnd
    
31.             End If
    
32.         End If
    
33.     End If
    
34. End Function
    
35. Sub ADDHOOK()
    
36.     hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, Application.Hinstance, 0)
    
37. End Sub
    
38. Sub UNHOOK()
    
39.     UnhookWindowsHookEx hHook
    
40.     hHook = 0
    
41. End Sub
    
42. Public Function getwindowhwnd()
    
43.     Dim p As POINTAPI
    
44.     GetCursorPos p
    
45.     windowshwnd = WindowFromPoint(p.X, p.Y)
    
46. End Function
    
47. 
    
48. 
    
49. 
    
50. 
    

复制代码

获得句柄.7z (16.47 KB, 下载次数: 45)

2020-1-18 13:48 上传

点击文件名下载附件

opiona

支持一下,以后会有用!