Probleme de format de DATERésolu

Question

Bonjour a tous,

Voici j'ai un probleme avec une converstion de DATE.  Je recoit une date sur un format de 4 BYTES, et je doit l'enregistrer dans un base de donnee ACCES.  Quand j'execute le logiciel dans l'environement VB, il n'y a pas de probleme, parcontre quand il est compiler il enverse le mois et le jour......  J'ai essayer 2 methodes sans resultat, je commence a manquer d'idee. J'ai fait un autre TEST, en enlevant la partie de l'heure tout semble revenir OK ?????? Un petit coup de main de votre part pour me mettre sur une piste serais apprecie

Merci Beaucoup

Steve

  CODE   --------------------------
Private Function ExtractDateGps(Str As String) As Date

Dim tAnnee As Single
Dim tMois As Single
Dim tJour As Single
Dim tHeure As Single
Dim tMinute As Single
Dim tSeconde As Single

Dim tDate1 As Date
Dim tDate2 As Date

On Error Resume Next

    tSeconde = (Val((Asc(Mid(Str, 1, 1))))) And 63
    tSeconde = tSeconde
        tMinute = (Val(Asc(Mid(Str, 2, 1))) * 256 + Asc(Mid(Str, 1, 1))) And 4032
        tMinute = tMinute / 64
            tHeure = (Val(Asc(Mid(Str, 3, 1))) * 256 + Asc(Mid(Str, 2, 1))) And 496
            tHeure = tHeure / 16
                tJour = (Val(Asc(Mid(Str, 3, 1)))) And 62
                tJour = tJour / 2
                    tMois = (Val(Asc(Mid(Str, 4, 1)) * 256) + Asc(Mid(Str, 3, 1))) And 960
                    tMois = tMois / 64
                        tAnnee = Val(Asc(Mid(Str, 4, 1))) And 252
                        tAnnee = tAnnee / 4
                        tAnnee = tAnnee + 2000

    
    'Methode 1
    'ExtractDateGps = DateSerial(tAnnee, tMois, tJour) & " " & TimeSerial(tHeure, tMinute, tSeconde)

    'Methode 2
    tDate1 = DateSerial(tAnnee, tMois, tJour)
    tDate2 = TimeSerial(tHeure, tMinute, tSeconde)
    
    ExtractDateGps = tDate1 & " " & tDate2

End Function

tiblay · Accepted Answer

Bonsoir a tous,

Voila j'ai trouve une solution TEMPORAIRE.  Je ne comprend toujours pas pourquoi la DATE est INVERSE quand j'ajout l'heure ??????  Je vous montre comment je regle pour le moment le probleme, mais j'aimerais trouver une solution plus  ''' JOLI ''''  

 Je ne mais pas le sujet REGLE car si quelqu'un a deja eu le meme probleme et a trouve une solution, je serais interesse de la voir

Merci de votre aide et en passant tres bon FORUM et EFFICAE 

Steve

--  CODE  ----------

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'  Receive STR from GPS, only 4 first BYTES used
'  Convert GPS DATE into local DATE
'  On error return 01-01-2000
'  BUG KNOW  invert month-day on EXE
'
' v 1.0
'  Dec 2007
'
'----------------------------------------------------------------------------
Private Function ExtractDateGps(Str As String) As Date

Dim tAnnee As Single
Dim tMois As Single
Dim tJour As Single
Dim tHeure As Single
Dim tMinute As Single
Dim tSeconde As Single
Dim tDateTemp As Date
Dim tNbrSec As Single

    On Error GoTo Err

        If Len(Str) < 4 Then
            ExtractDateGps = #1/1/2000#
            Exit Function
        End If

    tSeconde = (Val((Asc(Mid(Str, 1, 1))))) And 63
    tSeconde = tSeconde
        tMinute = (Val(Asc(Mid(Str, 2, 1))) * 256 + Asc(Mid(Str, 1, 1))) And 4032
        tMinute = tMinute / 64
            tHeure = (Val(Asc(Mid(Str, 3, 1))) * 256 + Asc(Mid(Str, 2, 1))) And 496
            tHeure = tHeure / 16
                tJour = (Val(Asc(Mid(Str, 3, 1)))) And 62
                tJour = tJour / 2
                    tMois = (Val(Asc(Mid(Str, 4, 1)) * 256) + Asc(Mid(Str, 3, 1))) And 960
                    tMois = tMois / 64
                        tAnnee = Val(Asc(Mid(Str, 4, 1))) And 252
                        tAnnee = tAnnee / 4
                        tAnnee = tAnnee + 2000

'----------------------------------------------------------------------------------
'  -- Solution TEMPORAIRE INVERSE MOIS-JOUR
'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
    tNbrSec = tNbrSec + ((tHeure * 60) * 60)
    tNbrSec = tNbrSec + (tMinute * 60)
    tNbrSec = tNbrSec + tSeconde
        tDateTemp = DateSerial(tAnnee, tMois, tJour)
    
    ExtractDateGps = DateAdd("s", tNbrSec, tDateTemp)                   'Assigne la REPONSE
'----------------------------------------------------------------------------------

    Exit Function

Err:
    ExtractDateGps = #1/1/2000#

End Function

cs_Exploreur · Answer

Salut,

Regarde ce que fait :

Private Sub Form_Load()
MsgBox Format$(Date, "MM\/DD\/YYYY")
MsgBox Format$(Date, "DD\/MM\/YYYY")
End Sub

A+
Exploreur

 Linux a un noyau, Windows un pépin

tiblay · Answer

Bonjour Explorer,

Le premier j'ai  12/05/2007

Le deuxieme j'ai 05/12/2007

Cette application tourne en SERVICE, mais je ne crois pas que cela fait une difference.  

Voici le dernier test que j'ai fait (code si dessous) et mon probleme ne semble pas venir de la converstion mais lorsque que mais la date dans la le FIELDS de la TABLE, je continue mais TEST et je vous tiens au nouvelle

Voici le code qui met les INFOS dans le RecordSet

                            fRs.AddNew
                                fRs.Fields("Data") = tStrData
                                fRs.Fields("FormatEvent") = tFormatEvent
                                fRs.Fields("MobileID") = tFichierPx.TruckId
                                fRs.Fields("DateImport") = tFichierPx.DateTrf
                                fRs.Fields("Serial") = tFichierPx.SerialNumber
                                fRs.Fields("DateEvent") = tDateGps
                                fRs.Fields("Crc") = tCrcValeur
                            fRs.Update

Merci

--  CODE TEST  --------------------------------------------

Option Explicit

Private Sub Command1_Click()

Dim tStr As String
Dim tDate As Date

    'assigne la DATE, juste une partie de la string
    tStr = Chr(16) & Chr(238) & Chr(10) & Chr(31)
                
    tDate = ExtractDateGps(tStr)
                
    MsgBox "Date convertie :  " & tDate & vbCrLf & "Date NOW : " & Now

End Sub

Private Function ExtractDateGps(Str As String) As Date

Dim tAnnee As Single
Dim tMois As Single
Dim tJour As Single
Dim tHeure As Single
Dim tMinute As Single
Dim tSeconde As Single

Dim tDate1 As Date
Dim tDate2 As Date

On Error Resume Next

    tSeconde = (Val((Asc(Mid(Str, 1, 1))))) And 63
    tSeconde = tSeconde
        tMinute = (Val(Asc(Mid(Str, 2, 1))) * 256 + Asc(Mid(Str, 1, 1))) And 4032
        tMinute = tMinute / 64
            tHeure = (Val(Asc(Mid(Str, 3, 1))) * 256 + Asc(Mid(Str, 2, 1))) And 496
            tHeure = tHeure / 16
                tJour = (Val(Asc(Mid(Str, 3, 1)))) And 62
                tJour = tJour / 2
                    tMois = (Val(Asc(Mid(Str, 4, 1)) * 256) + Asc(Mid(Str, 3, 1))) And 960
                    tMois = tMois / 64
                        tAnnee = Val(Asc(Mid(Str, 4, 1))) And 252
                        tAnnee = tAnnee / 4
                        tAnnee = tAnnee + 2000

    
    'Methode 1
    ExtractDateGps = DateSerial(tAnnee, tMois, tJour) & " " & TimeSerial(tHeure, tMinute, tSeconde)

    'Methode 2
'    tDate1 = DateSerial(tAnnee, tMois, tJour)
'    tDate2 = TimeSerial(tHeure, tMinute, tSeconde)
'
'    ExtractDateGps = tDate1 & " " & tDate2

End Function

tiblay · Answer

Bonsoir a tous de nouveau,

Voila les dernier TESTS.

J'ai LOGER les date que je calcul,  Le premier champ est la date a la sortie de ma FUNCTION, la deuxieme est la DATE de transfert, c'est une DATE qui vient d'une vartiable de type DATE, lu d'un fichier, et la 3 ieme est la date NOW, les 2 derniers sont OK, mais celle qui vient de ma FUNCTION est INVERSEE.....   

Quand je fait des TEST en mode developpement tout est OK, des que je compile, l'erreur se produit systematiquement.   

La je crois que j'ai vraiment besoin d'aide car plus je fais des TEST moins je comprend.... 

 --   CODE qui ecrit les DATES dans le FICHIER TEXT
                    .....
                        'String GPS SEUL
                        ElseIf tFormatEvent =  1 Then
                            'FLAG les DATAS
                            tStrData = tFichierPx.DataEvent
                            'Extrait les DATAS
                            tStrGps = Mid(tStrData, 2, 21)
                            'Extrait la DATE
                            tDateGps = ExtractDateGps(tStrGps)
                        End If
                        
 Write #tFree1, CStr(tDateGps), CStr(tFichierPx.DateTrf), CStr(Now) 
                        

------    FICHIER CREE en MODE COMPILE
"12/05/2007 14:56:16","05/12/2007 11:16:11","05/12/2007 19:49:16"
"12/05/2007 15:06:32","05/12/2007 11:16:11","05/12/2007 19:49:16"
"12/05/2007 15:06:36","05/12/2007 11:16:11","05/12/2007 19:49:16"
"12/05/2007 15:06:38","05/12/2007 11:16:12","05/12/2007 19:49:16"
"12/05/2007 15:06:40","05/12/2007 11:16:12","05/12/2007 19:49:16"
"12/05/2007 15:06:42","05/12/2007 11:16:12","05/12/2007 19:49:16"
"12/05/2007 15:06:44","05/12/2007 11:16:12","05/12/2007 19:49:16"
"12/05/2007 15:06:46","05/12/2007 11:16:12","05/12/2007 19:49:16"

-----  Le FICHIER CREE en MODE DEVELOPEMENT
"05/12/2007 14:56:16","05/12/2007 11:16:11","05/12/2007 20:02:38"
"05/12/2007 15:06:32","05/12/2007 11:16:11","05/12/2007 20:02:39"
"05/12/2007 15:06:36","05/12/2007 11:16:11","05/12/2007 20:02:41"
"05/12/2007 15:06:38","05/12/2007 11:16:12","05/12/2007 20:02:42"
"05/12/2007 15:06:40","05/12/2007 11:16:12","05/12/2007 20:02:42"
"05/12/2007 15:06:42","05/12/2007 11:16:12","05/12/2007 20:02:42"
"05/12/2007 15:06:44","05/12/2007 11:16:12","05/12/2007 20:02:42"
"05/12/2007 15:06:46","05/12/2007 11:16:12","05/12/2007 20:02:42"

---   CODE de la FUNCTION
Private Function ExtractDateGps(Str As String) As Date

Dim tAnnee As Single
Dim tMois As Single
Dim tJour As Single
Dim tHeure As Single
Dim tMinute As Single
Dim tSeconde As Single

Dim tDate1 As Date
Dim tDate2 As Date

On Error Resume Next

    tSeconde  = (Val((Asc(Mid(Str, 1, 1))))) And 63
    tSeconde = tSeconde
        tMinute = (Val(Asc(Mid(Str, 2, 1))) * 256 + Asc(Mid(Str, 1, 1))) And 4032
        tMinute = tMinute / 64
            tHeure = (Val(Asc(Mid(Str, 3, 1))) * 256 + Asc(Mid(Str, 2, 1))) And 496
            tHeure = tHeure / 16
                tJour = (Val(Asc(Mid(Str, 3, 1)))) And 62
                tJour = tJour / 2
                    tMois = (Val(Asc(Mid(Str, 4, 1)) * 256) + Asc(Mid(Str, 3, 1))) And 960
                    tMois = tMois / 64
                        tAnnee = Val(Asc(Mid(Str, 4, 1))) And 252
                        tAnnee = tAnnee / 4
                        tAnnee = tAnnee + 2000

    
    'Methode 1
    'ExtractDateGps = DateSerial(tAnnee, tMois, tJour) & " " & TimeSerial(tHeure, tMinute, tSeconde)

    'Methode 2
    tDate1 = DateSerial(tAnnee, tMois, tJour)
    tDate2 = TimeSerial(tHeure, tMinute, tSeconde)
    
    ExtractDateGps = tDate1 & " " & tDate2

End Function

Probleme de format de DATE

4 réponses

Votre réponse

Discussions similaires