简单用VBS调用企业微信机器人发定时消息的方法

2026-03-27 10:16:01发布 0次浏览

详情描述

方法一：VBS直接发送HTTP请求

' wechat_robot.vbs
Option Explicit

' 企业微信机器人Webhook地址
Dim webhook_url
webhook_url = "https://qyapi.weixin.qq.com/cgi-bin/webhook/send?key=你的机器人KEY"

' 发送文本消息
Sub SendTextMessage(content)
    Dim objHTTP, postData, response

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.open "POST", webhook_url, False
    objHTTP.setRequestHeader "Content-Type", "application/json"

    postData = "{""msgtype"": ""text"",""text"": {""content"": """ & content & """}}"

    objHTTP.send postData
    response = objHTTP.responseText

    ' 可选：记录发送结果
    MsgBox "发送结果：" & response
End Sub

' 发送Markdown消息
Sub SendMarkdownMessage(content)
    Dim objHTTP, postData

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.open "POST", webhook_url, False
    objHTTP.setRequestHeader "Content-Type", "application/json"

    postData = "{""msgtype"": ""markdown"",""markdown"": {""content"": """ & content & """}}"

    objHTTP.send postData
End Sub

' 使用示例
Call SendTextMessage("这是一条测试消息" & vbCrLf & "发送时间：" & Now())

方法二：结合Windows计划任务定时发送

1. 创建发送脚本

' send_notification.vbs
Dim content, currentTime
currentTime = Now()

' 根据时间设置不同的消息内容
If Hour(currentTime) = 9 And Minute(currentTime) = 0 Then
    content = "上午好！" & vbCrLf & "今日工作提醒：" & vbCrLf & "1. 晨会" & vbCrLf & "2. 项目进度检查"
ElseIf Hour(currentTime) = 17 And Minute(currentTime) = 30 Then
    content = "下班提醒：" & vbCrLf & "请提交今日工作日报" & vbCrLf & "时间：" & currentTime
End If

If content <> "" Then
    Dim objHTTP, webhook_url, postData
    webhook_url = "https://qyapi.weixin.qq.com/cgi-bin/webhook/send?key=你的机器人KEY"

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.open "POST", webhook_url, False
    objHTTP.setRequestHeader "Content-Type", "application/json"

    postData = "{""msgtype"": ""text"",""text"": {""content"": """ & content & """}}"
    objHTTP.send postData
End If

2. 创建计划任务批处理文件

@echo off
REM 创建Windows计划任务
REM 每天早上9点执行
schtasks /create /tn "企业微信晨会提醒" /tr "wscript.exe C:\path\to\send_notification.vbs" /sc daily /st 09:00

REM 每天下午5:30执行
schtasks /create /tn "企业微信日报提醒" /tr "wscript.exe C:\path\to\send_notification.vbs" /sc daily /st 17:30

方法三：完整定时消息系统

' wechat_scheduler.vbs
' 完整定时消息系统

Const WEBHOOK_KEY = "你的机器人KEY"
Const LOG_FILE = "C:\temp\wechat_send.log"

' 主函数
Sub Main()
    Dim scheduleTime, message

    ' 设置定时消息
    scheduleTime = "09:00"  ' 每天9点
    message = "工作提醒：" & vbCrLf & _
              "• 今日重点工作：" & vbCrLf & _
              "• 会议安排：" & vbCrLf & _
              "发送时间：" & Now()

    ' 检查是否到发送时间
    If FormatDateTime(Now(), 4) = scheduleTime Then
        SendToWeChat message
        LogMessage "消息已发送：" & message
    End If
End Sub

' 发送到企业微信
Sub SendToWeChat(content)
    Dim objHTTP, webhook_url, postData, response

    webhook_url = "https://qyapi.weixin.qq.com/cgi-bin/webhook/send?key=" & WEBHOOK_KEY

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.open "POST", webhook_url, False
    objHTTP.setRequestHeader "Content-Type", "application/json"

    ' 构建JSON数据
    postData = "{""msgtype"": ""text"",""text"": {""content"": """ & _
               EscapeJSON(content) & """}}"

    objHTTP.send postData
    response = objHTTP.responseText

    Set objHTTP = Nothing
End Sub

' 转义JSON特殊字符
Function EscapeJSON(str)
    If IsNull(str) Then Exit Function
    str = Replace(str, "\", "\\")
    str = Replace(str, """", "\""")
    str = Replace(str, vbCrLf, "\n")
    str = Replace(str, vbTab, "\t")
    EscapeJSON = str
End Function

' 日志记录
Sub LogMessage(msg)
    Dim fso, logFile
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(LOG_FILE) Then
        Set logFile = fso.OpenTextFile(LOG_FILE, 8) ' 8=追加
    Else
        Set logFile = fso.CreateTextFile(LOG_FILE)
    End If

    logFile.WriteLine Now() & " - " & msg
    logFile.Close
End Sub

' 运行主函数
Call Main()

方法四：使用Markdown格式发送更丰富的消息

' send_markdown.vbs
Dim webhook_url, markdownContent
webhook_url = "https://qyapi.weixin.qq.com/cgi-bin/webhook/send?key=你的机器人KEY"

markdownContent = _
"# 每日工作提醒" & vbCrLf & _
"**时间：** " & Now() & vbCrLf & _
"---" & vbCrLf & _
"## 今日任务" & vbCrLf & _
"1. 项目进度检查" & vbCrLf & _
"2. 团队会议" & vbCrLf & _
"3. 代码评审" & vbCrLf & _
"---" & vbCrLf & _
"> 温馨提示：请按时完成今日工作"

SendMarkdown markdownContent

Sub SendMarkdown(content)
    Dim objHTTP, postData

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.open "POST", webhook_url, False
    objHTTP.setRequestHeader "Content-Type", "application/json"

    postData = "{""msgtype"": ""markdown"",""markdown"": {""content"": """ & _
               EscapeJSON(content) & """}}"

    objHTTP.send postData

    If objHTTP.Status = 200 Then
        MsgBox "消息发送成功！"
    Else
        MsgBox "发送失败，状态码：" & objHTTP.Status
    End If
End Sub

Function EscapeJSON(str)
    str = Replace(str, "\", "\\")
    str = Replace(str, """", "\""")
    str = Replace(str, vbCrLf, "\n")
    EscapeJSON = str
End Function