vbs脚本和windows定时任务实现qq消息表情包定时发送功能

方案概览

VBS脚本 - 模拟键盘输入发送消息 Windows定时任务 - 按计划触发脚本执行 准备工作 - QQ需要在发送前处于活动状态

完整的VBS脚本

1. 基础消息发送脚本

' qq_message_sender.vbs
' 使用方法：双击运行或通过任务计划程序调用

Option Explicit

' 主函数
Sub SendQQMessage()
    Dim WshShell, objShell
    Set WshShell = CreateObject("WScript.Shell")

    ' 等待5秒，给您时间切换到QQ窗口
    WScript.Sleep 5000

    ' 模拟键盘输入消息内容
    WshShell.SendKeys "这是一条定时发送的QQ消息！{ENTER}"

    ' 如果需要发送表情
    WshShell.SendKeys "/wx{ENTER}"  ' 发送微信表情（QQ内置表情代码）
    WScript.Sleep 1000

    ' 发送更多内容
    WshShell.SendKeys "定时发送时间：" & Now() & "{ENTER}"

    Set WshShell = Nothing
End Sub

' 执行主函数
Call SendQQMessage()

2. 增强版脚本 - 支持参数和表情包

' qq_enhanced_sender.vbs
' 支持命令行参数：cscript qq_enhanced_sender.vbs "消息内容" [表情代码]

Dim WshShell, message, emoji
Set WshShell = CreateObject("WScript.Shell")

' 获取命令行参数
If WScript.Arguments.Count > 0 Then
    message = WScript.Arguments(0)
Else
    message = "这是默认的定时消息"
End If

If WScript.Arguments.Count > 1 Then
    emoji = WScript.Arguments(1)
Else
    emoji = "/se"  ' 默认表情：害羞
End If

Sub SendToQQ()
    ' 激活QQ窗口（假设QQ窗口标题包含"QQ"）
    On Error Resume Next
    WshShell.AppActivate "QQ"
    If Err.Number <> 0 Then
        MsgBox "请先打开QQ并切换到聊天窗口！", vbExclamation
        WScript.Quit
    End If
    On Error GoTo 0

    ' 等待窗口激活
    WScript.Sleep 2000)

    ' 发送表情
    WshShell.SendKeys emoji
    WScript.Sleep 300)
    WshShell.SendKeys "{ENTER}"

    ' 发送消息
    WScript.Sleep 500)
    WshShell.SendKeys message
    WScript.Sleep 300)
    WshShell.SendKeys "{ENTER}"

    ' 可选：发送时间戳
    WScript.Sleep 500)
    WshShell.SendKeys "[自动发送] " & Time()
    WshShell.SendKeys "{ENTER}"
End Sub

Call SendToQQ()

3. 特定联系人发送脚本

' qq_specific_contact.vbs
' 发送给特定QQ好友或群组

Dim WshShell
Set WshShell = CreateObject("WScript.Shell")

Sub SendToSpecificContact()
    ' 步骤1：激活QQ主窗口
    WshShell.AppActivate "QQ")
    WScript.Sleep 2000)

    ' 步骤2：使用快捷键打开搜索框（Ctrl+Alt+S是QQ默认搜索快捷键）
    WshShell.SendKeys "^(%s)")  ' Ctrl+Alt+S
    WScript.Sleep 1500)

    ' 步骤3：输入联系人名称
    WshShell.SendKeys "好友名称")  ' 修改为实际好友名称
    WScript.Sleep 2000)

    ' 步骤4：回车选择联系人
    WshShell.SendKeys "{ENTER}")
    WScript.Sleep 2000)

    ' 步骤5：发送消息
    WshShell.SendKeys "早上好！这是定时问候~{ENTER}")
    WScript.Sleep 500)

    ' 步骤6：发送表情（使用QQ表情代码）
    ' 常用表情代码：
    ' /dy 得意    /se 害羞    /hx 害羞
    ' /wx 微笑    /dk 大哭    /yx 白眼
    WshShell.SendKeys "/wx{ENTER}")  ' 微笑表情
End Sub

' 执行
Call SendToSpecificContact()

Windows定时任务设置步骤

方法1：通过图形界面设置

打开任务计划程序

Win+R 输入 taskschd.msc
或控制面板 → 管理工具 → 任务计划程序

创建基本任务

右侧点击"创建基本任务"
名称：QQ定时发送
触发器：选择每日、每周等
设置具体时间

配置操作

操作类型："启动程序"
程序/脚本：浏览选择 wscript.exe
添加参数："C:\路径\qq_message_sender.vbs"
起始于：C:\路径\

条件设置（重要）

勾选"只有在计算机使用交流电源时才启动此任务"
勾选"只有计算机唤醒时才启动此任务"

方法2：使用命令行创建（管理员权限）

@echo off
REM 创建QQ定时发送任务
schtasks /create /tn "QQ定时发送" /tr "wscript.exe C:\Scripts\qq_sender.vbs" /sc daily /st 09:00 /ru "用户名" /rp "密码"

实用脚本示例

每日早安问候

' morning_greeting.vbs
Dim greetings, rndIndex, WshShell
greetings = Array("早上好！", "新的一天开始啦！", "记得吃早餐哦~", "今天也要加油！")

Randomize
rndIndex = Int((UBound(greetings) + 1) * Rnd())

Set WshShell = CreateObject("WScript.Shell")
WScript.Sleep 5000)
WshShell.AppActivate "QQ")

If Time() < #12:00:00 PM# Then
    WshShell.SendKeys "早安！" & greetings(rndIndex) & "{ENTER}"
ElseIf Time() < #06:00:00 PM# Then
    WshShell.SendKeys "下午好！休息一下喝杯水吧~{ENTER}"
Else
    WshShell.SendKeys "晚上好！今天过得怎么样？{ENTER}"
End If

重要注意事项

1. 准备工作

QQ必须已登录并保持运行
发送前需确保聊天窗口已打开
建议关闭QQ的"发送消息快捷键"避免冲突

2. 安全设置

' 安全验证脚本 - 避免误操作
Dim answer
answer = MsgBox("确定要发送QQ消息吗？", vbYesNo + vbQuestion, "确认发送")

If answer = vbYes Then
    ' 执行发送代码
Else
    WScript.Quit
End If

3. 错误处理增强版

' robust_sender.vbs
On Error Resume Next

Dim maxAttempts, attempt
maxAttempts = 3
attempt = 1

Do While attempt <= maxAttempts
    If SendQQMessage() Then
        LogMessage "消息发送成功 - " & Now()
        Exit Do
    Else
        LogMessage "第" & attempt & "次尝试失败，5秒后重试"
        WScript.Sleep 5000)
        attempt = attempt + 1
    End If
Loop

Function SendQQMessage()
    ' 发送实现...
    SendQQMessage = True  ' 返回发送结果
End Function

Sub LogMessage(msg)
    Dim fso, logFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set logFile = fso.OpenTextFile("C:\QQ_Send_Log.txt", 8, True)
    logFile.WriteLine msg
    logFile.Close
End Sub

高级功能扩展

1. 从文件读取消息内容

' 读取文本文件发送
Dim fso, file, content
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile("C:\messages.txt", 1)
content = file.ReadAll()
file.Close

' 分割多行消息
Dim messages, i
messages = Split(content, vbCrLf)

For i = 0 To UBound(messages)
    If Trim(messages(i)) <> "" Then
        WshShell.SendKeys messages(i) & "{ENTER}"
        WScript.Sleep 1000)
    End If
Next

2. 节假日判断

' 检查是否为工作日
Function IsWorkday(date)
    Dim weekDay
    weekDay = Weekday(date)
    ' 周一至周五为工作日
    IsWorkday = (weekDay >= 2 And weekDay <= 6)
End Function

' 在发送前调用
If IsWorkday(Date()) Then
    Call SendQQMessage()
End If