【拋磚引玉】在Access中使用微信企業(yè)號(hào)2

fan0217

解決前次發(fā)布的代碼，返回字符串編碼問題：

1. '下列常量換成你自己的即可
   
2. Public Const Corpid = "wxf4a9ef92f9f6cXXX"  '企業(yè)Id,可從微信企業(yè)號(hào)后臺(tái)獲取
   
3. Public Const Corpsecret = "FH6346paGvlTOkN5JeU96TltGNmwxcCYUYqvWRm3Q2JVEnVL3egfLYNBLkIf_Aoy"  '管理組的憑證密鑰
   
4. 
   
5. '獲取AccessToken,Https請(qǐng)求方式: 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. '用了個(gè)較笨的方法，請(qǐng)自行找個(gè)解析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. '獲取發(fā)送消息的Json數(shù)據(jù)
    
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. '發(fā)送消息，,Https請(qǐng)求方式: POST
    
43. '參數(shù)    必須    說明
    
44. 'touser  否  成員ID列表（消息接收者，多個(gè)接收者用‘|’分隔，最多支持1000個(gè)）。特殊情況：指定為@all，則向關(guān)注該企業(yè)應(yīng)用的全部成員發(fā)送
    
45. 'toparty 否  部門ID列表，多個(gè)接收者用‘|’分隔，最多支持100個(gè)。當(dāng)touser為@all時(shí)忽略本參數(shù)
    
46. 'totag   否  標(biāo)簽ID列表，多個(gè)接收者用‘|’分隔。當(dāng)touser為@all時(shí)忽略本參數(shù)
    
47. 'msgtype 是  消息類型，此時(shí)固定為：text
    
48. 'agentid 是  企業(yè)應(yīng)用的id，整型�？稍趹�(yīng)用的設(shè)置頁(yè)面查看
    
49. 'content 是  消息內(nèi)容
    
50. 'safe    否  表示是否是保密消息，0表示否，1表示是，默認(rèn)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

復(fù)制代碼

參考文檔：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, "你好！這是測(cè)試消息，收到請(qǐng)回復(fù)。--fans發(fā)送")
    
12. End Sub
    

復(fù)制代碼

示例：

zpy2

ret = xmlHttp.responseText
這句返回utf8，要轉(zhuǎn)吧。
另外，簽名里的erp要微信才行嗎？
來自: 微社區(qū)

fan0217

zpy2 發(fā)表于 2016-12-29 11:33
ret = xmlHttp.responseText
這句返回utf8，要轉(zhuǎn)吧。
另外，簽名里的erp要微信才行嗎？

這段代碼經(jīng)過測(cè)試的，替換成自己的參數(shù)即可。

zpy2

沒有企業(yè)號(hào)，應(yīng)該是不錯(cuò)的。這代碼與erp都要企業(yè)號(hào)嗎？
來自: 微社區(qū)

fan0217

zpy2 發(fā)表于 2016-12-29 11:42
沒有企業(yè)號(hào)，應(yīng)該是不錯(cuò)的。這代碼與erp都要企業(yè)號(hào)嗎？

代碼需要微信企業(yè)號(hào)
ERP非必須，可直接用戶名密碼登錄

zpy2

我用手機(jī)訪問的，登陸后顯示請(qǐng)?jiān)谄髽I(yè)微信號(hào)中登陸。大概電腦才行吧。
來自: 微社區(qū)

access新新新手

老師您好！請(qǐng)講講如何使用的

fan0217

access新新新手 發(fā)表于 2017-8-29 10:19
老師您好！請(qǐng)講講如何使用的

上面已經(jīng)講了啊