Sendkeys 和 Sendmessage 使用技巧一例

博客展示了使用VB代码实现高精度平方根计算的方法。通过调用Windows API函数,如SendMessage、FindWindow等,结合计算器程序,向其发送按键消息进行计算,并获取结果。代码还给出了从17到24的平方根计算示例。

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Function sqrx(ByVal x As Double) As String '计算平方根(比VB DOUBLE 类型精度高)
Dim temp As String, i As Long, j As Long
Shell "Calc.EXE", vbMinimizedNoFocus '运行计算器
temp = x & "y0.5="
For i = 1 To Len(temp)
SendKeys Mid(temp, i, 1), True '向计算器顺序发送按键消息X (X^Y) 0.5=
Next
temp = String(64, Chr(0))
i = FindWindow(vbNullString, "计算器") '窗口句柄
j = FindWindowEx(i, ByVal 0&, "Edit", vbNullString) '编辑框句柄
SendMessage j, &HD, Len(temp), ByVal temp '发送编辑框文本至temp
SendKeys "%{F4}", True '调用ALT+F4关闭计算器窗口
sqrx = temp
End Function

Private Sub Command1_Click()
Dim i As Integer
For i = 17 To 24
Debug.Print "sqrx(" & i & ")=" & sqrx(i)
Next
End Sub

 

返回:
sqrx(17)=4.1231056256176605498214098559741                              
sqrx(18)=4.2426406871192851464050661726291                              
sqrx(19)=4.3588989435406735522369819838596                              
sqrx(20)=4.4721359549995793928183473374626                              
sqrx(21)=4.582575694955840006588047193728                               
sqrx(22)=4.6904157598234295545656301135445                              
sqrx(23)=4.7958315233127195415974380641627                              
sqrx(24)=4.8989794855663561963945681494118                              

 

Sub YY() ' 声明变量(新增fileNameWithExt存储带扩展名的文件名) Dim targetGroup As String, filePath As String, fileNameWithExt As String, fileName As String Dim wsh As Object, shellApp As Object, ws As Worksheet Dim fileExist As Boolean, folderPath As String ' -------------------------- 1. 初始化与参数校验 On Error Resume Next Set ws = ActiveSheet Set wsh = CreateObject("WScript.Shell") Set shellApp = CreateObject("Shell.Application") On Error GoTo 0 If ws Is Nothing Then MsgBox "请先激活操作工作表!", vbExclamation Exit Sub End If ' 读取微信群名(B5) targetGroup = Trim(ws.Range("B5").Value) If targetGroup = "" Then MsgBox "B5单元格未填写微信群名!", vbCritical Exit Sub End If ' 读取文件路径(H1),拆分【文件夹路径】→【带扩展名的文件名】→【纯前缀文件名】 filePath = Trim(ws.Range("H1").Value) fileExist = (Dir(filePath) <> "") If filePath = "" Or Not fileExist Then MsgBox "H1单元格路径无效或文件不存在!", vbCritical Exit Sub End If ' 步骤1:拆分文件夹路径(例:C:\Users\HP\Desktop\) folderPath = Left(filePath, InStrRev(filePath, "\")) ' 步骤2:拆分带扩展名的完整文件名(例:娜250902.xlsx) fileNameWithExt = Mid(filePath, InStrRev(filePath, "\") + 1) ' 步骤3:关键修改——去掉.xlsx扩展名,只保留前缀(例:娜250902) fileName = Left(fileNameWithExt, InStrRev(fileNameWithExt, ".") - 1) ' 1. 打开文件所在文件夹,获取窗口标题(避免固定“桌面”,适配任意文件夹) shellApp.Open (folderPath) Application.Wait Now + TimeValue("0:0:2") ' 等待文件夹完全打开 Dim folderWinTitle As String folderWinTitle = wsh.ExpandEnvironmentStrings("%USERPROFILE%") ' 适配系统路径,确保获取正确窗口 folderWinTitle = Replace(folderPath, folderWinTitle, "此电脑") ' 转换为资源管理器显示的标题格式(例:此电脑\桌面) ' 2. 激活文件夹窗口,打开搜索框(按Ctrl+F快速定位搜索框,无需猜TAB次数) wsh.AppActivate folderWinTitle Application.Wait Now + TimeValue("0:0:1") wsh.SendKeys "^f", True ' 直接打开文件夹搜索框(通用操作,无需调整) Application.Wait Now + TimeValue("0:0:1") ' 3. 输入提取的fileName(无前缀)搜索,等待结果加载 wsh.SendKeys fileName, True ' wsh.SendKeys fullFileName, True wsh.SendKeys "{Enter}", True End Sub按全名 列如娜20250902在文件搜索框搜索
最新发布
09-03
评论
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符
 
红包 添加红包
表情包 插入表情
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值