剛剛做的一個(gè)項(xiàng)目需要用到asp群發(fā)微信公眾號(hào)的模板消息， 以前沒做過(guò)，想了一會(huì)用了下面這種方法實(shí)現(xiàn)的模板消息群發(fā)推送，效果很好。

TmplMsg.asp代碼如下 如下

<%Class TmplMsg Private s_AppID, s_AppSecret Private s_Access_Token Public Property Let Access_Token(ByVal value)s_Access_Token = valueEnd PropertyPublic Property Get Access_Token() Access_Token = Get_Access_Token() End Property Private Sub Class_Initialize s_AppID = "wx1fc0edfcdc7d38c2" 'APPID s_AppSecret = "3fd1a59b2555523fb1c79f34afef9ad4" 'AppSecret End Sub Private Sub Class_Terminate() End Sub Public Function Send_TmplMsg(ByVal touser, ByVal template_id, ByVal url, ByVal first_data, ByVal first_color, ByVal keyword1_data, ByVal keyword1_color, ByVal keyword2_data, ByVal keyword2_color, ByVal keyword3_data, ByVal keyword3_color, ByVal keyword4_data, ByVal keyword4_color, ByVal remark_data, ByVal remark_color) Dim SAT SAT = Get_Access_Token() If Len(SAT) = 0 Then SAT = Get_Access_Token() End If Dim Json_Temp Json_Temp = "{" &_ """touser"": """& touser &"""," &_ """template_id"": """& template_id &"""," If url <> "" Then Json_Temp = Json_Temp & """url"": """& url &"""," Json_Temp = Json_Temp & """data"": {" &_ """first"": {" &_ """value"": """& first_data &"""," &_ """color"": """& first_color &"""" &_ "}," &_ """keyword1"":{""value"":"""& keyword1_data &""",""color"":"""& keyword1_color &"""}," &_ """keyword2"":{""value"":"""& keyword2_data &""",""color"":"""& keyword2_color &"""}," &_ """keyword3"":{""value"":"""& keyword3_data &""",""color"":"""& keyword3_color &"""}," &_ """keyword4"":{""value"":"""& keyword4_data &""",""color"":"""& keyword4_color &"""}," &_ """remark"": {" &_ """value"": """& remark_data &"""," &_ """color"": """& remark_color &"""" &_ "}" &_ "}" &_ "}" '發(fā)送請(qǐng)求 Send_TmplMsg = HttpSend("https://api.weixin.qq.com/cgi-bin/message/template/send?access_token="& SAT, "POST", Json_Temp)End Function '獲取微信的Access_Token Public Function Get_Access_Token() If s_Access_Token <> "" Then Get_Access_Token = s_Access_Token Exit Function End If If Application("Access_Token_Expires") <> "" Then If DateDiff("n", Application("Access_Token_Expires"), Now()) > 120 Then Application.Lock Application("Access_Token") = "" Application("Access_Token_Expires") = "" Application.Unlock End If End If Dim s_result If Application("Access_Token") = "" Then s_result = HttpSend("https://api.weixin.qq.com/cgi-bin/token?grant_type=client_credential&appid="& s_AppID &"&secret="& s_AppSecret, "GET", "") IF instr(s_result,"access_token")>0 Then Dim Json Set Json = parseJSON(s_result) Application.Lock Application("Access_Token") = Json.access_token Application("Access_Token_Expires") = Now() Application.Unlock Set obj = Nothing Else Get_Access_Token = s_result End IF Else Get_Access_Token = Application("Access_Token") End IF End Function Private Function HttpSend(ByVal Url, ByVal Method, ByVal Data) On ErrOr Resume NextDim Http Set Http = Server.CreateObject("MSXML2.SERVERXMLHTTP.3.0")With Http.open Method, Url, False .setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded" .send(Data) If .ReadyState <> 4 Then HttpSend = "ReadyState:" & .ReadyState Exit Function End If If .Status <> 200 Then HttpSend = "Status:" & .Status Exit Function End IF HttpSend = BytesToBstr(.ResponseBody)End WithSet Http = Nothing If Err.number<>0 Then HttpSend = "Error:" & Err.Description Err.Clear End IFEnd FunctionPublic Function BytesToBstr(ByVal Body) Dim ObjstReam set ObjstReam = Server.CreateObject("Adodb.Stream")With ObjstReam.Type = 1 .Mode =3 .Open .Write Body .Position = 0 .Type = 2 .Charset = "UTF-8" BytesToBstr = .ReadText .Close End WithSet ObjstReam = Nothing End FunctionEnd Class%>引用方法代碼如下<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%><% 'Application("Access_Token")="" Dim a Set a = New TmplMsg Dim openid, template_id, url, first_data, first_color, keyword1_data, keyword1_color, keyword2_data, keyword2_color, keyword3_data, keyword3_color, keyword4_data, keyword4_color, keyword5_data, keyword5_color, remark_data, remark_color openid = "opSHYjnZAnqPh8Cy9LIOEQXnlA90" '接收者openid template_id = "atfaINoGHQmDNQ01Lx3jmokln5TT5X1YMStpCTjBZSg" '模板ID url = "http://w9899v.com/" '模板跳轉(zhuǎn)鏈接（海外帳號(hào)沒有跳轉(zhuǎn)能力） first_data = "您剛剛成功發(fā)布了一個(gè)新職位，趕緊推廣一下吧！" ' first_color = "#000000" '字體顏色 keyword1_data = "JAVA開發(fā)工程師" keyword1_color = "#000000" keyword2_data = "上海" keyword2_color = "#000000" keyword3_data = "50-80萬(wàn)/年" keyword3_color = "#000000" keyword4_data = "2014-08-07 16：11" keyword4_color = "#000000" remark_data = "點(diǎn)擊詳情后立即推廣職位" remark_color = "#000000" Dim s_resbb=array("opSHYjnZAnqPh8Cy9LIOEQXnlA90","opSHYjnZAnqPh8Cy9LIOEQXnlA90","opSHYjnZAnqPh8Cy9LIOEQXnlA90")for j=0 to ubound(bb) s_res = a.Send_TmplMsg(bb(j), template_id, url, first_data, first_color, keyword1_data, keyword1_color, keyword2_data, keyword2_color, keyword3_data, keyword3_color, keyword4_data, keyword4_color, remark_data, remark_color) nextIf split(split(s_res,",")(0),":")(1) = 0 Then Response.Write("成功") Else Response.Write("失敗")&"
"response.Write s_res&"
"&Application("Access_Token") End If Set a = Nothing%>絕對(duì)可用