用VBS控制鼠标(获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击)

标签: Excel.Application, VB, VBS, VBScript, Windows API, 鼠标

不止一个人问过我怎样用VBS控制鼠标操作,比如:怎么用VBS获取鼠标指针的坐标位置?怎么用VBS移动鼠标?怎么用VBS模拟鼠标左键单击、左键双击、右键单击?……

网上搜到的答案普遍是VBS无法实现,或者是要用第三方COM(ActiveX?)组件。我对第三方组件是很反感的,使用第三方组件毫无可移植性可言,因为别人的系统中不一定注册了这个组件。我的建议是,尽量不要在VBS代码中调用第三方组件,除非你的程序只是写来自己用。(顺便说一下,也尽量不要用不靠谱的Sendkeys方法,原因不解释)

 

好了,废话就说这么多,现在说说用VBS控制鼠标的方法。我以前写过一篇《VBS调用Windows API函数》,本以为既然都能调用API了,用VBS控制鼠标还不是很简单是事?事实证明我错了,不明真相的同学永远是大多数,不知道API是什么的VBSer大有人在。不贴出实实在在的代码,他们根本不会自己写!

使用此代码的前提是你的系统上安装了Excel,因为要用到Excel.Application对象(如果你偏要认为这算第三方组件我也没话说):

 

    
    
    
    
  1. Option Explicit 
  2. Dim WshShell 
  3. Dim oExcel, oBook, oModule 
  4. Dim strRegKey, strCode, x, y 
  5. Set oExcel = CreateObject("Excel.Application") '创建 Excel 对象 
  6. set WshShell = CreateObject("wscript.Shell") 
  7.  
  8. strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM" 
  9. strRegKey = Replace(strRegKey, "$", oExcel.Version) 
  10. WshShell.RegWrite strRegKey, 1, "REG_DWORD" 
  11.  
  12. Set oBook = oExcel.Workbooks.Add '添加工作簿 
  13. Set oModule = obook.VBProject.VBComponents.Add(1) '添加模块 
  14. strCode = _ 
  15. "'Author: Demon"            & vbCrLf & _ 
  16. "'Website: http://demon.tw" & vbCrLf & _ 
  17. "'Date: 2011/5/10"          & vbCrLf & _ 
  18. "Private Type POINTAPI : X As Long : Y As Long : End Type"                                                                                                                            & vbCrLf & _ 
  19. "Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long"                                                                                     & vbCrLf & _ 
  20. "Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long"                                                                                                  & vbCrLf & _ 
  21. "Private Declare Sub mouse_event Lib ""user32"" Alias ""mouse_event"" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)" & vbCrLf & _ 
  22. "Public Function GetXCursorPos() As Long"                                                                                                                                             & vbCrLf & _ 
  23.     "Dim pt As POINTAPI : GetCursorPos pt : GetXCursorPos = pt.X"                                                                                                                     & vbCrLf & _ 
  24. "End Function"                                                                                                                                                                        & vbCrLf & _ 
  25. "Public Function GetYCursorPos() As Long"                                                                                                                                             & vbCrLf & _ 
  26.     "Dim pt As POINTAPI: GetCursorPos pt : GetYCursorPos = pt.Y"                                                                                                                      & vbCrLf & _ 
  27. "End Function" 
  28. oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码 
  29. 'Author: Demon 
  30. 'Website: http://demon.tw 
  31. 'Date: 2011/5/10 
  32. x = oExcel.Run("GetXCursorPos") '获取鼠标 X 坐标 
  33. y = oExcel.Run("GetYCursorPos") '获取鼠标 Y 坐标 
  34. WScript.Echo x, y 
  35. oExcel.Run "SetCursorPos", 30, 30 '设置鼠标 X Y 坐标 
  36. Const MOUSEEVENTF_MOVE       = &H1 
  37. Const MOUSEEVENTF_LEFTDOWN   = &H2 
  38. Const MOUSEEVENTF_LEFTUP     = &H4 
  39. Const MOUSEEVENTF_RIGHTDOWN  = &H8 
  40. Const MOUSEEVENTF_RIGHTUP    = &H10 
  41. Const MOUSEEVENTF_MIDDLEDOWN = &H20 
  42. Const MOUSEEVENTF_MIDDLEUP   = &H40 
  43. Const MOUSEEVENTF_ABSOLUTE   = &H8000 
  44. '模拟鼠标左键单击 
  45. oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 
  46. '模拟鼠标左键双击(即快速的两次单击) 
  47. oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 
  48. oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 
  49. '模拟鼠标右键单击 
  50. oExcel.Run "mouse_event", MOUSEEVENTF_RIGHTDOWN + MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0 
  51. '模拟鼠标中键单击 
  52. oExcel.Run "mouse_event", MOUSEEVENTF_MIDDLEDOWN + MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0 
  53. '关闭 Excel 
  54. oExcel.DisplayAlerts = False 
  55. oBook.Close 
  56. oExcel.Quit