VBA实现企业微信API获取考勤数据,解析JSON数据格式。


'通过微信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值。
VBA实现企业微信API获取考勤数据,解析JSON数据格式。_第1张图片

你可能感兴趣的:(IT,公司,vba,json,vba)