600字范文,内容丰富有趣,生活中的好帮手!
600字范文 > html企业微信发送消息 VBA使用企业微信机器人发送信息

html企业微信发送消息 VBA使用企业微信机器人发送信息

时间:2021-12-26 10:48:01

相关推荐

html企业微信发送消息 VBA使用企业微信机器人发送信息

求助大神,现在想用企业微信机器人发送消息,但是在网上找到的教程不知道怎么改,小白表示看不懂,,还请大神帮助。。

企业微信机器人 地址 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

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。