1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| Public Sub historique(ByVal code As String, ByVal centre As String)
Dim centreactuel, obsactuel, histocentreaff, histoobs, req, req2 As String
Dim dateaffactuelle, histodateaff As Date
If dsTmp.State <> adStateClosed Then
dsTmp.Close
End If
req = "select historique_date_affectation, historique_centre, historique_observations, date_affectation, centre_de_secours, observations from " & lireIni(SectFile, "fichier") & " where n_ddsis='" & code & "'"
dsTmp.Open req, cnx
'si centre de secours à ce jour
'ne peut pas être vierge en réalité. le si n'est pas indispensable
If IsNull(dsTmp.Fields(4).Value) Then
centreactuel = ""
Else
centreactuel = dsTmp.Fields(4).Value
End If
'si date affectation à ce jour
If IsNull(dsTmp.Fields(3).Value) Then
dateaffactuelle = Format(Date, "dd/mm/yyyy")
Else
dateaffactuelle = dsTmp.Fields(3).Value
End If
'si observations à ce jour
If IsNull(dsTmp.Fields(5).Value) Then
obsactuel = ""
Else
obsactuel = dsTmp.Fields(5).Value
End If
'si ancienne date affectation
If IsNull(dsTmp.Fields(0).Value) Then
histodateaff = Format(Date, "dd/mm/yyyy")
Else
histodateaff = dsTmp.Fields(0).Value
End If
'si ancien centre de secours
If IsNull(dsTmp.Fields(1).Value) Then
histocentreaff = ""
Else
histocentreaff = dsTmp.Fields(1).Value
End If
'si ancienne observation
If IsNull(dsTmp.Fields(2).Value) Then
histoobs = ""
Else
histoobs = dsTmp.Fields(2).Value
End If
'met à jour les historiques en concaténant l'ancienne chaine avec la nouvelle
'centreaff = centreaff & oldcentre
'obs = obs & oldobs
On Error GoTo err
req2 = "update " & lireIni(SectFile, "fichier") & " set centre_de_secours=" & Chr(34) & centre & Chr(34) & ", date_affectation=" & Chr(34) & CDate(Date) & Chr(34) & ", historique_date_affectation=" & Chr(34) & CDate(dateaffactuelle) & Chr(34) & ", historique_centre=" & Chr(34) & centreactuel & Chr(34) & ", historique_observations=" & Chr(34) & obsactuel & Chr(34) & ", observations=" & Chr(34) & Chr(34) & " where n_ddsis='" & code & "'"
cmdTmp.ActiveConnection = cnx
cmdTmp.CommandText = req2
cnx.BeginTrans
cmdTmp.Execute
cnx.CommitTrans
Exit Sub
err:
cnx.RollbackTrans
MsgBox err.Description
End Sub |
Partager