|
|
楼主 |
发表于 2024-9-3 14:10
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub sendwx()
'声明为对象
'Dim wcht As Object
'声明为工作表
Dim sht As Worksheet
'调用操作系统外壳命令
'Set wcht = CreateObject("wscript.shell")
Dim wcht As Object
Set wcht = CreateObject("WScript.Shell")
wcht.Run "mshta vbscript:clipboarddata.setdata(""text"",""*" & Text & "*""):close()"
Set wcht = Nothing
'声明为活动工作表
Set sht = ActiveSheet
'清空剪贴板
'wcht.Run "mshta vbscript:clipboarddata. setdata(""text"","""")(close)"
'对应快捷键 Ctrl+Alt+w 打开微信
'wcht.SendKeys "^%w"
SendKeys "^%w"
'延时0.8秒，等微信反应过来
Application.Wait (Now() + TimeSerial(0, 0, 1) * 0.8)
'遍历所有要发消息的行
For i = 2 To sht.Cells(Rows.Count, "a").End(xlUp).Row
'将活动工作表A列微信名或昵称复制到剪贴板中
'wcht.Run "mshta vbscript:clipboarddata. setdata(""text"",""" & sht.Cells(i, 1) & """)(close)"
sht.Cells(i, 1).Copy ' 将单元格的值复制到剪贴板
Application.CutCopyMode = False ' 这会将复制的内容放到剪贴板
'延时0.8秒，等微信反应过来
Application.Wait (Now() + TimeSerial(0, 0, 1) * 0.8)
'Ctr1+F 快捷键进入微信查找栏
'wcht.SendKeys "^f"
SendKeys "^f"
'延时秒
Application.Wait (Now() + TimeSerial(0, 0, 1) * 0.8)
'Ctr1+y快捷键将剪贴板中的微信名或昵称枯贴到微信查找栏
'wcht.SendKeys "^v"
SendKeys "^v"
'延时0.8秒
Application.Wait (Now() + TimeSerial(0, 0, 1) * 0.8)
'键击“回车”键，激活对应微信名或昵称的窗体界面
'wcht.SendKeys "{enter}"
SendKeys "{enter}"
'延时0.8秒
Application.Wait (Now() + TimeSerial(0, 0, 1) * 0.8)
'将活动工作表B列要发送的内容复制到剪贴板中
'wcht.Run "mshta vbscript:clipboarddata. setdata(""text"",""" & sht.Cells(i, 2) & """)(close)"
sht.Cells(i, 2).Copy ' 将单元格的值复制到剪贴板
Application.CutCopyMode = False ' 这会将复制的内容放到剪贴板
'延时0.8秒
Application.Wait (Now() + TimeSerial(0, 0, 1) * 0.8)
'Ctrl v贴要发送的内容
'wcht.SendKeys "^v"
SendKeys "^v"
'延时0.8秒
Application.Wait (Now() + TimeSerial(0, 0, 1) * 0.8)
'回车键发送消息
'wcht.SendKeys "{enter}"
SendKeys "{enter}"
n = n + 1
Next i
Set wcht = Nothing
MsgBox "已完成,共发" & n & "条信息!", vbInformation
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-9-3 14:01
