Payroll Macro

Get_Payroll_info.bas

Attribute VB_Name = "Module1"
Function isDriverActive(grpId As String, drvId As String, api_key As String) As Boolean
    Dim URL As String, JsonString As String, objHTTP As Object, stMs As String, edMs As String, timeNow As Double
    timeNow = DateDiff("s", #1/1/1970#, Now())
    edMs = Str(timeNow * 1000)
    stMs = Str((timeNow * 1000) - 691200000)

    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    URL = "https://api.samsara.com/v1/fleet/drivers/" & drvId & "?access_token=" & api_key
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "Content-type", "application/json"
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    
    groupID = """groupId"": " & grpId
    
    JsonString = "{" & groupID & "}"
    objHTTP.Send JsonString
    'Debug.Print (objHTTP.responseText)
    'Debug.Print (StrComp(objHTTP.responseText, "driver.isDeactivated=true", 1))
    isDriverActive = (StrComp(objHTTP.responseText, "driver.isDeactivated=true", 1) = -1)

End Function

Function GetHOSLogs(api_key As String, grpId As String, drvId As String, stMs, edMs) As String
    Dim URL As String, JsonString As String, objHTTP As Object

    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    URL = "https://api.samsara.com/v1/fleet/hos_logs?access_token=" & api_key
    objHTTP.Open "POST", URL, False
    objHTTP.setRequestHeader "Content-type", "application/json"
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    
    groupID = """groupId"": " & grpId
    driverId = """driverId"": " & drvId
    startMS = """startMs"": " & stMs
    endMS = """endMs"": " & edMs
    
    JsonString = "{" & groupID & "," & driverId & "," & startMS & "," & endMS & "}"
    'Debug.Print (JsonString)
    objHTTP.Send JsonString
    'Debug.Print (objHTTP.responseText)
    GetHOSLogs = objHTTP.responseText

End Function

Function GetDrivers(grpId As String, api_key As String) As String

    Dim URL As String, JsonString As String, objHTTP As Object, y As Integer

    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    URL = "https://api.samsara.com/v1/fleet/drivers?access_token=" & api_key
    objHTTP.Open "POST", URL, False
    objHTTP.setRequestHeader "Content-type", "application/json"
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    
    groupID = """groupId"": " & grpId
    
    JsonString = "{" & groupID & "}"
    'Debug.Print (JsonString)
    objHTTP.Send JsonString
    'Debug.Print (objHTTP.responseText)
    GetDrivers = objHTTP.responseText
End Function

Public Function GetTimeFromMilliSeconds(MILLISEC As Double) As String
    Dim intTotalSeconds As Long
    Dim intMinutes As Integer
    Dim intHour As Integer
    intTotalSeconds = Fix(MILLISEC / 1000)
    intHour = Fix(intTotalSeconds / 3600)
    intMinutes = Fix((intTotalSeconds Mod 3600) / 60)
    intSeconds = (intTotalSeconds Mod 3600) Mod 60
    
    GetTimeFromMilliSeconds = intHour & ":" & intMinutes & ":" & intSeconds
End Function


'***************************************************************************************************************************
'***************************************************************************************************************************
'***************************************************************************************************************************
'***************************************************************************************************************************


Sub DetRecapHours()
    Dim API_Token As String, groupID As String, startMS As String, endMS As String
    
    API_Token = ""
    groupID = "1234"
    startMS = "1575187200000"
    endMS = "1575705600000"
    
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        
    [A1].Value = "Driver Name"
    [B1].Value = "Time Worked"
    [C1].Value = "Tags"
    Set sh = ActiveSheet
    
    drivers_JSON = GetDrivers(groupID, API_Token)
    
    Set driver_jsonObject = JsonConverter.ParseJson(drivers_JSON)
    For Each driver In driver_jsonObject("drivers")
        Dim driverId As String
        driverId = Trim(Str(driver("id")))
        If (driver("isDeactivated") = "False") Then
            hos_logs_JSON = GetHOSLogs(API_Token, groupID, driverId, startMS, endMS)
            If Not (hos_logs_JSON = "{""logs"":[]}") Then
                Dim log_status As String, vehicle_id As Double, log_start_time As Double, signed_in As Boolean, total_time As Double
                log_status = ""
                log_start_time = 0
                signed_in = False
                total_time = 0
                Set hos_logs_jsonObject = JsonConverter.ParseJson(hos_logs_JSON)
                                
                For Each hos_logs In hos_logs_jsonObject("logs")
                    If (CDbl(hos_logs("logStartMs")) >= CDbl(startMS)) Then
                        vehicle_id = hos_logs("vehicleId")
                        log_status = hos_logs("hosStatusType")
                        'Debug.Print (vehicle_id & " - " & log_status)
                        
                        If (vehicle_id > 0 And signed_in = False) Then
                            log_start_time = hos_logs("logStartMs")
                            signed_in = True
                        End If
                        
                        If (vehicle_id = 0 And log_status = "OFF_DUTY" And signed_in = True) Then
                            total_time = total_time + hos_logs("logStartMs") - log_start_time
                            signed_in = False
                            log_start_time = 0
                        End If
                    End If
                Next
                If (signed_in = True) Then
                    total_time = total_time + CDbl(endMS) - log_start_time
                End If
                If (total_time > 0) Then
                    Debug.Print (driver("name") & " - " & (total_time / 3600000))
                End If
            End If
        End If
    Next

    sh.Columns("A:C").AutoFit
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub