【抛砖引玉】在Access中使用微信企业号2

fan0217

解决前次发布的代码，返回字符串编码问题：

1. '下列常量换成你自己的即可
   
2. Public Const Corpid = "wxf4a9ef92f9f6cXXX"  '企业Id,可从微信企业号后台获取
   
3. Public Const Corpsecret = "FH6346paGvlTOkN5JeU96TltGNmwxcCYUYqvWRm3Q2JVEnVL3egfLYNBLkIf_Aoy"  '管理组的凭证密钥
   
4. 
   
5. '获取AccessToken,Https请求方式: GET
   
6. Private Function GetTokenJson() As String
   
7.     Dim url  As String
   
8.     Dim ret()  As Byte
   
9.     Dim token As String
   
10.         url = "https://qyapi.weixin.qq.com/cgi-bin/gettoken?corpid=" & Corpid & "&corpsecret=" & Corpsecret
    
11.         ret = HttpGet(url)
    
12.         token = ret
    
13.         GetTokenJson = token
    
14. End Function
    
15. 
    
16. '用了个较笨的方法，请自行找个解析JSON的方法替代
    
17. Public Function GetToken() As String
    
18.         Dim tokenJson As String
    
19.         tokenJson = GetTokenJson
    
20.         Dim tmp As String
    
21.         tmp = Split(tokenJson, ",")(0)
    
22.         tmp = Split(tmp, ":")(1)
    
23.         tmp = Replace(tmp, """", "")
    
24.         GetToken = tmp
    
25. End Function
    
26. 
    
27. '获取发送消息的Json数据
    
28. Public Function GetSendTextJson(touser As String, agentid As Integer, content As String) As String
    
29.     Dim str As String
    
30.         str = str & "{"
    
31.         str = str & Replace("""touser"": ""#touser"",", "#touser", touser)
    
32.         str = str & """msgtype"": ""text"","
    
33.         str = str & Replace("""agentid"": #agentid,", "#agentid", agentid)
    
34.         str = str & """text"": {"
    
35.         str = str & Replace("""content"": ""#content""", "#content", content)
    
36.         str = str & "},"
    
37.         str = str & """safe"":0"
    
38.         str = str & "}"
    
39.         GetSendTextJson = str
    
40. End Function
    
41. 
    
42. '发送消息，,Https请求方式: POST
    
43. '参数    必须    说明
    
44. 'touser  否  成员ID列表（消息接收者，多个接收者用‘|’分隔，最多支持1000个）。特殊情况：指定为@all，则向关注该企业应用的全部成员发送
    
45. 'toparty 否  部门ID列表，多个接收者用‘|’分隔，最多支持100个。当touser为@all时忽略本参数
    
46. 'totag   否  标签ID列表，多个接收者用‘|’分隔。当touser为@all时忽略本参数
    
47. 'msgtype 是  消息类型，此时固定为：text
    
48. 'agentid 是  企业应用的id，整型。可在应用的设置页面查看
    
49. 'content 是  消息内容
    
50. 'safe    否  表示是否是保密消息，0表示否，1表示是，默认0
    
51. Public Function SendText(token As String, touser As String, agentid As Integer, text As String) As String
    
52.     Dim url As String
    
53.     Dim jsonData As String
    
54.     Dim ret()  As Byte
    
55.         url = "https://qyapi.weixin.qq.com/cgi-bin/message/send?access_token=" & token
    
56. 
    
57.         jsonData = GetSendTextJson(touser, agentid, text)
    
58.         Debug.Print jsonData
    
59.         
    
60.         ret = HttpPost(url, jsonData)
    
61.         
    
62.         SendText = ret
    
63.         
    
64. End Function
    
65. 
    
66. Function HttpGet(url As String) As String
    
67.      Dim xmlHttp As Object
    
68.      Set xmlHttp = CreateObject("Msxml2.XMLHTTP.3.0")
    
69.      If Not IsObject(xmlHttp) Then
    
70.          Set xmlHttp = CreateObject("Msxml2.XMLHTTP.3.0")
    
71.          If Not IsObject(xmlHttp) Then Exit Function
    
72.      End If
    
73.      xmlHttp.Open "GET", url, False
    
74.      xmlHttp.setRequestHeader "CONTENT-TYPE", "application/json;charset=UTF-8"
    
75.      xmlHttp.send
    
76. 
    
77.      Do While xmlHttp.ReadyState <> 4
    
78.          DoEvents
    
79.      Loop
    
80.   
    
81.         Dim ret As String
    
82.         ret = xmlHttp.responseText
    
83. 
    
84.        HttpGet = ret
    
85. End Function
    
86. 
    
87. Function HttpPost(url As String, postMsg As String) As String
    
88.      Dim xmlHttp As Object
    
89.      Set xmlHttp = CreateObject("Msxml2.XMLHTTP.3.0")
    
90.      If Not IsObject(xmlHttp) Then
    
91.          Set xmlHttp = CreateObject("Msxml2.XMLHTTP.3.0")
    
92.          If Not IsObject(xmlHttp) Then Exit Function
    
93.      End If
    
94.      xmlHttp.Open "POST", url, False
    
95.      xmlHttp.setRequestHeader "CONTENT-TYPE", "application/Json;charset=UTF-8"
    
96.      xmlHttp.send (postMsg)
    
97. 
    
98.      Do While xmlHttp.ReadyState <> 4
    
99.          DoEvents
    
100.      Loop
     
101. 
     
102.         Dim ret As String
     
103.         ret = xmlHttp.responseText
     
104.         HttpPost = ret
     
105. End Function

复制代码

参考文档：http://qydev.weixin.qq.com/wiki/ ... 3%E8%AF%B4%E6%98%8E

1. 
   
2. Sub Test()
   
3.     Dim token As String
   
4.     token = GetToken
   
5.     Debug.Print token
   
6. End Sub
   
7. 
   
8. Sub SendTest()
   
9.     Dim token As String
   
10.     token = GetToken
    
11.     Debug.Print SendText(token, "@all", 0, "你好！这是测试消息，收到请回复。--fans发送")
    
12. End Sub
    

复制代码

示例：

zpy2

ret = xmlHttp.responseText
这句返回utf8，要转吧。
另外，签名里的erp要微信才行吗？
来自: 微社区

fan0217

zpy2 发表于 2016-12-29 11:33
ret = xmlHttp.responseText
这句返回utf8，要转吧。
另外，签名里的erp要微信才行吗？

这段代码经过测试的，替换成自己的参数即可。

zpy2

没有企业号，应该是不错的。这代码与erp都要企业号吗？
来自: 微社区

fan0217

zpy2 发表于 2016-12-29 11:42
没有企业号，应该是不错的。这代码与erp都要企业号吗？

代码需要微信企业号
ERP非必须，可直接用户名密码登录

zpy2

我用手机访问的，登陆后显示请在企业微信号中登陆。大概电脑才行吧。
来自: 微社区

access新新新手

老师您好！请讲讲如何使用的

fan0217

access新新新手 发表于 2017-8-29 10:19
老师您好！请讲讲如何使用的

上面已经讲了啊