FONCTIONS INSERT UPDATE POUR ACCESS PROJET ADP

' insertion via objet ADO: Tablename = table de destination
' InsertValues = (champ1, valeur1, champ2, valeur2, etc)
Public Function FN_INSERT(Tablename As String, ParamArray InsertValues() As _
    Variant) As Boolean
      Dim oRS As ADODB.Recordset, i As Long

10       On Error GoTo FN_INSERT_Error

20        Set oRS = New ADODB.Recordset
30        oRS.Open Tablename, CurrentProject.Connection, adOpenStatic, _
              adLockOptimistic
40        With oRS
50            .AddNew
60            For i = LBound(InsertValues) To UBound(InsertValues) Step 2
70                If Not IsEmpty(InsertValues(i + 1)) Then
80                    Select Case .Fields(InsertValues(i)).Type
                      Case adDate, adDBDate, adDBTime, adDBTimeStamp
90                        .Fields(InsertValues(i)).Value = _
                              CDate(Replace(InsertValues(i + 1), "'", ""))
100                   Case Else
110                       .Fields(InsertValues(i)).Value = InsertValues(i + 1)
120                   End Select
130               End If
140           Next i
150           .Update
160           .Close
170       End With
180       FN_INSERT = True

190   Exit Function
FN_INSERT_Error:
200       MsgBox "Error " & Err.Number & " (" & Err.Description & _
          ") in Function FN_INSERT of Module mdSql", vbCritical

End Function


' mise à jour via objet ADO: Tablename = table de destination
' critère = clause where des enregistrements à modifier
' InsertValues = (champ1, valeur1, champ2, valeur2, etc)
Public Function FN_UPDATE(Tablename As String, Critere As String, ParamArray _
    InsertValues() As Variant) As Boolean
10       On Error GoTo FN_UPDATE_Error

      Dim oRS As ADODB.Recordset
      Dim SQL As String, i As Long
      ' si on a un nombre impair d'arguments InsertValues() :
      ' le dernier (booléen) indique si on log ou pas les modifs
          
30        SQL = "SELECT * FROM " & Tablename & " WHERE " & Critere
40        Set oRS = New ADODB.Recordset
50        oRS.Open SQL, CurrentProject.Connection, adOpenStatic, adLockOptimistic
60        With oRS
70            Do Until .EOF
80                For i = LBound(InsertValues) To UBound(InsertValues) - 1 Step 2
                      
100                   If Not IsEmpty(InsertValues(i + 1)) Then
110                       .Fields(InsertValues(i)).Value = InsertValues(i + 1)
120                   End If
130               Next i
140               .Update
150               .MoveNext
160           Loop
170           .Close
180       End With
190       FN_UPDATE = True
          
200       Exit Function

FN_UPDATE_Error:

210       MsgBox "Error " & Err.Number & " (" & Err.Description & _
              ") in Function FN_UPDATE of Module mdSql", vbCritical
          
End Function