Office中國(guó)論壇/Access中國(guó)論壇

標(biāo)題: 【拋磚引玉】在Access中使用微信企業(yè)號(hào)2 [打印本頁(yè)]
作者: fan0217    時(shí)間: 2016-12-28 23:19
標(biāo)題: 【拋磚引玉】在Access中使用微信企業(yè)號(hào)2
本帖最后由 fan0217 于 2016-12-28 23:21 編輯

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

  1. '下列常量換成你自己的即可
  2. Public Const Corpid = "wxf4a9ef92f9f6cXXX"  '企業(yè)Id,可從微信企業(yè)號(hào)后臺(tái)獲取
  3. Public Const Corpsecret = "FH6346paGvlTOkN5JeU96TltGNmwxcCYUYqvWRm3Q2JVEnVL3egfLYNBLkIf_Aoy"  '管理組的憑證密鑰

  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

  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

  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

  42. '發(fā)送消息，,Https請(qǐng)求方式: POST
  43. '參數(shù)    必須    說(shuō)明
  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

  57.         jsonData = GetSendTextJson(touser, agentid, text)
  58.         Debug.Print jsonData
  59.         
  60.         ret = HttpPost(url, jsonData)
  61.         
  62.         SendText = ret
  63.         
  64. End Function

  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

  77.      Do While xmlHttp.ReadyState <> 4
  78.          DoEvents
  79.      Loop
  80.   
  81.         Dim ret As String
  82.         ret = xmlHttp.responseText

  84.        HttpGet = ret
  85. End Function

  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)

  98.      Do While xmlHttp.ReadyState <> 4
  99.          DoEvents
  100.      Loop

  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



  2. Sub Test()
  3.     Dim token As String
  4.     token = GetToken
  5.     Debug.Print token
  6. End Sub

  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    時(shí)間: 2016-12-29 11:33
ret = xmlHttp.responseText
這句返回utf8，要轉(zhuǎn)吧。
另外，簽名里的erp要微信才行嗎？
作者: fan0217    時(shí)間: 2016-12-29 11:37
zpy2 發(fā)表于 2016-12-29 11:33
ret = xmlHttp.responseText
這句返回utf8，要轉(zhuǎn)吧。
另外，簽名里的erp要微信才行嗎？

這段代碼經(jīng)過(guò)測(cè)試的，替換成自己的參數(shù)即可。
作者: zpy2    時(shí)間: 2016-12-29 11:42
沒(méi)有企業(yè)號(hào)，應(yīng)該是不錯(cuò)的。這代碼與erp都要企業(yè)號(hào)嗎？
作者: fan0217    時(shí)間: 2016-12-29 11:48
本帖最后由 fan0217 于 2016-12-29 11:51 編輯
zpy2 發(fā)表于 2016-12-29 11:42
沒(méi)有企業(yè)號(hào)，應(yīng)該是不錯(cuò)的。這代碼與erp都要企業(yè)號(hào)嗎？

代碼需要微信企業(yè)號(hào)
ERP非必須，可直接用戶名密碼登錄
作者: zpy2    時(shí)間: 2016-12-29 12:00
我用手機(jī)訪問(wèn)的，登陸后顯示請(qǐng)?jiān)谄髽I(yè)微信號(hào)中登陸。大概電腦才行吧。
作者: access新新新手    時(shí)間: 2017-8-29 10:19
老師您好！請(qǐng)講講如何使用的
作者: fan0217    時(shí)間: 2017-9-6 23:32
access新新新手 發(fā)表于 2017-8-29 10:19
老師您好！請(qǐng)講講如何使用的

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



歡迎光臨 Office中國(guó)論壇/Access中國(guó)論壇 (http://www.mzhfr.cn/) Powered by Discuz! X3.3