Add and display time greater than 24 hours in Access 2007 VBA

Navigation
0

I'm using Access 2007 to develop a garage control form, which provides travel information made by drivers. I need to calculate the total amount of time for each trip, and this period can be longer than 24 hours. I was able to calculate without problems when the period is less than 24 hours, but I noticed that the Access Date / Time field can not store the information I need in this situation. The calculated time field information is stored in text format.

Follow my code

Common Time Calculation: 

Private Sub txtHoraChegada_LostFocus()
Dim HoraChegada As Date
Dim HoraSaida As Date
Dim HoraTotal As Date
Dim DataViagem As Date
Dim HorasCalculadas
Dim DiasCalculados

DataViagem = Me.txtDataViagem.Value
HoraChegada = Me.txtHoraChegada.Value
HoraSaida = Me.txtHoraSaida.Value

If HoraChegada < HoraSaida Then 'Verifica se a Hora de Chegada é MENOR que a Hora de Saída
    If HoraChegada = 0 Then 'Verifica se a Hora de Chegada foi meia noite
        HoraChegada = 24
        HoraTotal = DateAdd("h", HoraChegada, HoraSaida)
        DiasCalculados = DateAdd("d", 1, DataViagem)
    End If
    HoraTotal = ((HoraChegada - HoraSaida) + 24) * (-1)
    DiasCalculados = DateAdd("d", 1, DataViagem)
    MsgBox "O período da viagem é maior que 24h, a data de chegada foi ajustada", vbInformation, "Atenção" 'Mensagem ao usuário
End If

If HoraChegada = HoraSaida Then 'Verifica se a Hora de Chegada é igual à Hora de Saída
    HoraTotal = 24
    Dias = 1
    DiasCalculados = DateAdd("d", 1, DataViagem)
End If

If HoraChegada > HoraSaida Then 'Verifica se a Hora de Chegada é Maior que a Hora de Saída
    HoraTotal = HoraChegada - HoraSaida
    DiasCalculados = DataViagem
End If

Me.txtQtdeDias = Dias
Me.txtDuracaoTotal.Value = Format(HoraTotal, "hh:nn") 'Imprime o valor calculado da duração da viagem na caixa de texto
Me.txtDataChegada.Value = DiasCalculados 'Imprime a data de chegada do motorista na caixa de texto

End Sub

I made a button that should add an extra day (or 24h) to previously calculated hours 

Private Sub btnMaisDias_Click()
  dteStart = txtDataViagem
  dteEnd = txtDataChegada
  Call DisplayHours((dteStart), (dteEnd))

End Sub

And this is the function called by the button (gives division error by zero) 

Public Function DisplayHours(dteStart As Date, dteEnd As Date) As String
    Dim lngMin As Long, lngHrs As Long
    lngMin = DateDiff("n", dteStart, dteEnd)
    lngHrs = lngMin / 60
    DisplayHours = lngHrs & ":" & Format(lngMin Mod lngHrs, "00")

End Function

I'm relatively new to programming, can anyone identify what I'm doing wrong?

    
asked by anonymous 20.09.2018 / 13:48

1 answer

0

According to some information I found there, the Access Date / Time field is unable to store a value greater than 24 hours, so I took a different approach. I made the field into a text field and did the calculation as follows. 

Private Sub txtHoraChegada_LostFocus()
Dim HoraChegada As Date
Dim HoraSaida As Date
Dim HoraTotal As Date
Dim DataViagem As Date
Dim HorasCalculadas
Dim DiasCalculados
Dim horas, minutos
Dim interval

DataViagem = Me.txtDataViagem
HoraChegada = Me.txtHoraChegada
HoraSaida = Me.txtHoraSaida
DataChegada = Me.DataChegada

        If HoraChegada < HoraSaida Then 'Verifica se a Hora de Chegada é MENOR que a Hora de Saída
            If HoraChegada = 0 Then 'Verifica se a Hora de Chegada foi meia noite
                HoraChegada = 24
                HoraTotal = DateAdd("h", HoraChegada, HoraSaida)
                DiasCalculados = DateAdd("d", 1, DataViagem)
            End If
            HoraChegada = HoraChegada + 24
            HoraTotal = DateDiff("n", HoraSaida, HoraChegada)
        End If

        If HoraChegada = HoraSaida Then 'Verifica se a Hora de Chegada é igual à Hora de Saída
            HoraTotal = 24
            Dias = 1
            DiasCalculados = DateAdd("d", 1, DataViagem)
        End If

        If HoraChegada > HoraSaida Then 'Verifica se a Hora de Chegada é Maior que a Hora de Saída
            HoraTotal = HoraChegada - HoraSaida
            DiasCalculados = DataViagem
        End If


        interval = HoraChegada - HoraSaida
        Dias = DateDiff("d", DataViagem, DataChegada)
        horas = DateDiff("n", HoraViagem, HoraChegada)
        minutos = Int(CSng(interval * 1440)) Mod 60

        If Dias > 0 Then
            Me.txtDuracaoTotal.Value = Dias & " d " & Format(HoraTotal, "hh") & " h " & minutos & " m"
        Else
            Me.txtDuracaoTotal.Value = Format(HoraTotal, "hh") & " h " & minutos & " m"
        End If
        txtDuracaoTotal.SetFocus
End Sub
    
01.10.2018 / 15:10
Invert Dynamic Stack Error in Using Javascript Code in Sharepoint 2010