说明:
本案例是使用clsWindow2.2控制QQ桌面版来发送消息的。原理是模拟人工操作:选择对应的人员或群 -> 点击消息框 -> 输入框中输入消息 -> 按回车,代码注释很详细,看下就能明白,有一定vb基础的人可以改成群发,定时发送,群中@发送。稍加改造可以作为很好的一款群管理工具,比如定时发送消息通知给相关的人。
测试环境:
win7x64 + QQ9.2.2 + clsWindow2.2
说明: 如果不能用可能是您的版本太旧,或者QQ软件更新导致一些控件位置大小改变,请仔细检查并修改相应代码。以下代码2020-02-05测试通过,本代码不保证更新。
声明:
本代码免费,可用于任何商业用途,但请勿做非法用途,所引起的一切后果由使用者本人承担。
代码:
用法参考:sendQQMsg "clswindow交流群", "大家好,现在时间是" & Now()
Private Sub sendQQMsg(ByVal strName$, ByVal strMsg$) Dim w As New clsWindow If w.GetWindowByTitle(strName).hWnd <> 0 Then w.Normal '设置窗口正常,防止当前是最小化到任务栏的 w.Focus w.ClickPoint w.Left + 35, w.Top + w.Height - 100, absolute, , 300, 500 SendKeys strMsg & "{ENTER}" Else MsgBox "未发现包含“strName”的QQ聊天窗口,请打开对应的窗口再测试,注意请在面板上取消勾选“合并勾选窗口”", vbExclamation End If Set w = Nothing End Sub
版本2 有些电脑上会失效,那么可以尝试使用这个版本,通过剪切板操作的
Private Sub sendQQMsg2(ByVal strName$, ByVal strMsg$) Dim w As New clsWindow If w.GetWindowByTitle(strName).hWnd <> 0 Then w.SetPosNormal w.Focus w.ClickPoint w.Left + 35, w.Top + w.Height - 100, absolute w.Wait 20 Clipboard.Clear Clipboard.SetText strMsg SendKeys "^{v}" SendKeys "%{s}" w.Wait 2 Else MsgBox "未发现包含“strName”的QQ聊天窗口,请打开对应的窗口再测试,注意请在面板上取消勾选“合并勾选窗口”", vbExclamation End If Set w = Nothing End Sub
完整工程下载: 链接: pan.baidu.com/s/1q-r0f7-H… 提取码: ut85