求助大神,现在想用企业微信机器人发送消息,但是在网上找到的教程不知道怎么改,小白表示看不懂,,还请大神帮助。。
企业微信机器人 地址 https://qyapi./cgi-bin/webhook/send?key=fdab73c1-5820-43bf-ba68-9cc0ff084557
网上找到的VBA程式
Dim Url As String
Const CorpID As String = "abc123456789"'企业在企业微信ID
Dim Secret As String
Const SendText As String = "{""touser"": ""成员ID"",""toparty"": ""部门ID"",""totag"": ""标签ID"",""msgtype"": ""text"",""agentid"": 1000040,""text"" : { ""content"":""消息内容""},""safe"":0}"
Const ErrCode As String = """errcode"":0,""errmsg"":""ok"""
Function Token(CorpID As String, Secret As String) As String
'获取Token 提醒一天只能获取 2000次,最好获取后保存方便调用
Secret = "" '用于发送消息的应用Secret
Dim http
Set http = CreateObject("MSXML2.ServerXMLHTTP")
Url = "https://qyapi./cgi-bin/gettoken?corpid=" & CorpID & "&corpsecret=" & Secret & ""
http.Open "get", Url, False 'post get 都可以
http.send ""
If http.Status = 200 Then
Token = http.responseText
End If
'Debug.Print Token
'分解
If InStr(Token, "access_token") > 1 Then
Token = Split(Token, ",")(2)
'Debug.Print Token
Token = Split(Token, ":")(1)
'Debug.Print Token
Token = Replace(Token, """", "")
' Debug.Print Token
Else
Token = ""
End If
End Function
Function SendMsg(Str1 As String) As String
'发消息
Dim http
Secret = "" '用于发送消息的应用Secret
TokenStr = Token(CorpID, Secret)
Set http = CreateObject("MSXML2.ServerXMLHTTP")
Url = "https://qyapi./cgi-bin/message/send?access_token=" & TokenStr & ""
http.Open "Post", Url, False
http.send Str1
rs = http.responseText'返回值
If http.Status = 200 Then
Str2 = http.responseText
End If
If InStr(Str2, ErrCode) = 0 Then MsgBox "错误:" & SendMsg
End Function
Sub SendQWMsg()
If MsgBox("确认发送企微消息吗?", vbYesNo, "请选择") = vbYes Then
Dim Str1 As String
TokenStr = Token(CorpID, Secret)
'Debug.Print TokenStr
With Sheet1
Str0 = ""
For r = 4 To 100 '发送列表
Str1 = Replace(SendText, "成员ID", " 成员ID号 ")
Str1 = Replace(Str1, "部门ID", "@all")
Str1 = Replace(Str1, "标签ID", "@all")
Str1 = Replace(Str1, "1000040", "发送消息的应用id")
Str1 = Replace(Str1, "消息内容", "
消息内容标题 消息内容如有疑问,可直接回复!")
'发送消息
Str1 = SendMsg(Str1)
'切割结果
MyArr = Split(rs, ",")
a = Replace(Replace(MyArr(2), """invaliduser:""", ""), """", "")
Select Case a
Case "invaliduser:"
a = "发送成功"
Case Else
a = "发送失败,失败账号为" & a
End Select
Sheet1.Cells(r, 4) = a'第四列放发送结果状态
Next r
End With
rs = ""
End If
MsgBox ("发送完成,请检查D列发送状态")
End Sub