|
本帖最后由 huang1314wei 于 2022-6-16 09:16 编辑
前言
偶然的机会,因友人叫我帮忙做一个微信给指定联系人发消息的VBA,论坛搜索了一下,有不少类似的贴子,比如
1、分享一个自动发送微信消息的工具,链接地址: https://club.excelhome.net/thread-1548082-4-1.html
该贴采用方法是向微信窗口发送相应的按钮来实现,实际用了一下,效果不太理想
2、Excel消息整合发送器-发微信、QQ、邮件、短信 链接地址: https://club.excelhome.net/thread-1537142-1-1.html
该贴采用VBS方式,实际用了一下,当微信没有启动或者未激活的时候,发送有问题,窗口有乱跳的感觉
3、VBA发送微信消息 链接地址: https://club.excelhome.net/thread-1324912-1-1.html
该贴采用调用微信官方API,发送消息应该没有问题,但是该方法需要企业的CorpID和Secret,这个东西普通人申请还是挺麻烦的,对于个人想要来点普通的自动要求,过程繁琐了点
。。。。。。。。。。
相应的发微信贴子,在此我就不详细列举了,在网上看到有不少发微信例子都是调用FlaUI.Core实现的,无奈,该开源组件用c#很好调用 ,
但是VBA没法直接使用,为此,我抽时间做一个搬运工,将该组件封装成COM,供VBA调用,组件共4个方法:
第一个方法: QueryContacts 批量采集聊天窗口的群聊及联系人名称
第二个方法: QueryContactsAll 批量采集通讯录联系人昵称,如昵称含表情则为?号显示
第三个方法: SendMessage 向指定联系人名称发送消息或者文件
第三四方法: SendQQMessage 向QQ指定昵称或QQ号、群名发送文件或消息
运行过程我就不截图了,具体示代码如下:
- Sub WeChat()
- Dim obj As WeChatTool.WeChatClass
- Set obj = New WeChatClass
- 'Set obj = CreateObject("WeChatTool.WeChatClass")
-
- '第一个方法: QueryContacts 批量采集聊天窗口的群聊及联系人名称
- '第二个方法: QueryContactsAll 批量采集通讯录联系人昵称,如昵称含表情则为?号显示
- '第三个方法: SendMessage 向指定联系人名称发送消息或者文件
- '第三四方法: SendQQMessage 向QQ指定昵称或QQ号、群名发送文件或消息
-
-
- '第1个参数: 文件完整路径,如果不发文件可以传空字符串
- '第2个参数: 微信名或群聊微信名称 ,不可为空
- '第3个参数: 消息内容
- 'obj.SendMessage "", "文件传输助手", Now() & " 发送了一条测试消息!"
-
-
- '第1个参数: 文件完整路径,如果不发文件可以传空字符串
- '第2个参数: QQ昵称、QQ群名称或QQ号 ,不可为空
- '第3个参数: 消息内容
- 'obj.SendQQMessage "", "403456877", Now() & " 发送了一条测试消息!"
- End Sub
复制代码
已知不足及提醒:
1、运行过程中,应避免人为移动鼠标或者其他操作,以免影响操作结果
2、如果运行无反应,可以去dll安装目录 D盘WeChatTool目录中的 log.txt查看失败原因
3、组件需要.net4.5支持
4、如果想要了解更多,可以参见开源组件FlaUI.Core的github地址 https://github.com/FlaUI/FlaUI
2022-06-14 更新:
1、新增微信批量采集通讯录联系人
2、解决联系人搜索不到的时候跳出搜索弹窗的问题
3、新增QQ消息发送 注:因QQ支持多进程,暂只支持当前电脑登陆一个QQ的消息发送,QQ窗口句柄因为查询比较耗时,发送可能较慢或有发送失败的可能
4、新增tlb文件,直接引用之后,可以在VBE里面前期绑定使用对象里面的方法,如果不引用,也可以直接用 CreateObject("WeChatTool.WeChatClass") 创建对象
2022-06-15 更新
1、增加句柄查询方式,降低因句柄查询失败导致的发送失败的概率
2、新增了容错,在联系人查找不到时,增加一次列表点击,能一定程度解决循环发送时,因联系人查找不到导致后续全部发送失败的概率
PS:因Windws消息机制,窗口消息刷新不同电脑有一定差异,因此,建议循环向联系人发送消息时,请自行增加延时,大概代码如下
- For i = 1 To n
- firsttime = Timer
- Do Until Timer - firsttime > 5 '等待5秒之后
- DoEvents '交出执行控制权,以便操作系统能够处理其他事件
- Loop
- obj.SendMessage "", "文件传输助手", Now() & " 发送了一条测试消息!"
- Next
复制代码 更新文件
安装之后,如果运行代码报错,可以在VBE里面工具---引用---浏览---找到D盘WeChatTool目录,文件类型选所有,引用一下那个tlb文件,然后再试一下
|
评分
-
19
查看全部评分
-
|