'通过微信API接口发送和获取数据
Function weixinAPI(starttime As String, endtime As String) As String
Dim access_token$, url$
Dim userId() As String, userName() As String
'企业ID
id = "ww11***********8f9"
'应用secret
corpsecret = "18Zf7O**********************DJkiXI70"
With CreateObject("Msxml2.ServerXMLHTTP")
'获取access_token链接
url = "https://qyapi.weixin.qq.com/cgi-bin/gettoken" & "?corpid=" & id & "&corpsecret=" & corpsecret
.Open "GET", url, False
.send
'截取access_token值
access_token = Split(Split(.responsetext, "access_token"":""")(1), """,""expires_in")(0)
'获取员工id链接
url = "https://qyapi.weixin.qq.com/cgi-bin/user/simplelist?access_token=" & access_token & "&department_id=2&fetch_child=0"
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/json;charset=utf-8"
.send
'解析员工ID
userJSON .responsetext, userId, userName
'获取打卡数据链接
url = "https://qyapi.weixin.qq.com/cgi-bin/checkin/getcheckin_monthdata?debug=1&access_token=" & access_token
sendData = "{""starttime"": " & starttime & ",""endtime"": " & endtime & ",""useridlist"": [""" & Join(userId, """,""") & """]}"
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/json;charset=utf-8"
.send (sendData)
'解析考勤数据
attendanceJSON .responsetext
'weixinAPI = .responsetext
End With
End Function
'员工列表解析
Function userJSON(strJSON As String, userId() As String, userName() As String)
Dim objJS As Object
Dim strJSCode As String
'创建JS对象
Set objJS = CreateObject("MSScriptControl.ScriptControl")
objJS.Language = "javascript"
'在JS下 将字符串转换成JOSN对象
strJSCode = "var json = " & strJSON & ";"
objJS.AddCode (strJSCode)
'在JS下 获取数组长度
strJSCode = "function getJsonLength(jsonData){var jsonLength=0;for(var item in jsonData){jsonLength++}return jsonLength};"
objJS.AddCode (strJSCode)
'通过KEY名称获取值
'Sheets("考勤表").Cells(1, 2).Value = objJS.Eval("json.errmsg")
'Sheets("考勤表").Cells(2, 2).Value = objJS.Eval("json.errcode")
'获取数组的长度
For i = 0 To objJS.Eval("getJsonLength(json['userlist'])") - 1
ReDim Preserve userId(i)
userId(i) = objJS.Eval("json['userlist'][" & i & "]['userid']")
ReDim Preserve userName(i)
userName(i) = objJS.Eval("json['userlist'][" & i & "]['name']")
Next i
Set objJS = Nothing
End Function
'考勤数据解析
Function attendanceJSON(strJSON As String)
Dim objJS As Object
Dim strJSCode As String
'创建JS对象
Set objJS = CreateObject("MSScriptControl.ScriptControl")
objJS.Language = "javascript"
'在JS下 将字符串转换成JOSN对象
strJSCode = "var json = " & strJSON & ";"
objJS.AddCode (strJSCode)
'在JS下 获取数组长度
strJSCode = "function getJsonLength(jsonData){var jsonLength=0;for(var item in jsonData){jsonLength++}return jsonLength};"
objJS.AddCode (strJSCode)
For i = 0 To objJS.Eval("getJsonLength(json['datas'])") - 1
'通过KEY名称获取值
Sheets("考勤表").Cells(1, i + 1).Value = objJS.Eval("json.errmsg")
Sheets("考勤表").Cells(2, i + 1).Value = objJS.Eval("json.errcode")
'获取数组的长度
Sheets("考勤表").Cells(9, i + 1).Value = objJS.Eval("getJsonLength(json['datas'])")
'获取数组下的值
Sheets("考勤表").Cells(3, i + 1).Value = objJS.Eval("json['datas'][" & i & "]['base_info']['name']")
Sheets("考勤表").Cells(4, i + 1).Value = objJS.Eval("json['datas'][" & i & "]['base_info']['acctid']")
Sheets("考勤表").Cells(5, i + 1).Value = objJS.Eval("json['datas'][" & i & "]['base_info']['departs_name']")
Sheets("考勤表").Cells(6, i + 1).Value = objJS.Eval("json['datas'][" & i & "]['summary_info']['work_days']")
Sheets("考勤表").Cells(7, i + 1).Value = objJS.Eval("json['datas'][" & i & "]['summary_info']['regular_days']")
Sheets("考勤表").Cells(8, i + 1).Value = objJS.Eval("json['datas'][" & i & "]['overwork_info']['workday_over_sec']")
Next i
Set objJS = Nothing
End Function
Function ToUnixTime(strTime, intTimeZone)
If IsEmpty(strTime) Or Not IsDate(strTime) Then strTime = Now
If IsEmpty(intTimeZone) Or Not IsNumeric(intTimeZone) Then intTimeZone = 0
ToUnixTime = DateAdd("h", -intTimeZone, strTime)
ToUnixTime = DateDiff("s", "1970-1-1 0:0:0", ToUnixTime)
End Function
如果微信返回错误码301023,虽然他提示如下错误,但实际有可能是你的userid值给错了导致的,必须使用系统已经存在的userid值。