Home » 文章 » 电脑技术 » Excel » VBA给企业微信人员发送消息

VBA给企业微信人员发送消息

VBA给企业微信人员发送消息如何用VBA给企业微信人员发送消息呢?如何用Excel给企业微信用户发消息 如何用Excel给企业微信用户发消息?Excel VBA 通过企业微信发信息?Excel 如何用vba控制通过企业微信将内容发送到指定人员?

以下方法配置好后,在企业微信给员工发工资条信息,十分的方便。而且是免费的,无需借助第三方付费应用,无需上传工资条模板。发送效果及代码如下。记得,粘贴代码后,将”和'都替换成英文符号才能用:

ba1d1f08ed56a6e3b771

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.weixin.qq.com/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.weixin.qq.com/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, “消息内容”, “<div class=\””gray\””>消息内容标题</div> <div class=\””normal\””>消息内容</div><div class=\””highlight\””>如有疑问,可直接回复!</div>”)
‘发送消息
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

 

如需协助配置的,请留言。

微信 OR 支付宝 扫描二维码
为博主 打个赏
pay_weixinpay_zhifubao
金额随意 快来“打”我呀~

16 comments

  1. 爱就爱啦

    从百度点进来的,学习学习,呵呵!

  2. 您好,我需要配置

  3. 13922155969 电话

  4. 我需要配置文件

  5. 你好,这些代码放到excel里后,还要做其它配置吗?

  6. 我需要配置

  7. 我需要配置

  8. 我需要配置

  9. 我需要配置13390543335

  10. liaoliangbang

    我需要配置18073218190

Leave a Reply

Your email address will not be published. Required fields are marked *

*