Fonctions insert update pour access projet adp

Commenter

Contenu du snippet

C'est sans doute bête mais j'ai eu des problèmes avec les accents sur mes requêtes INSERT et UPDATE avec la commande CurrentProject.Connection.Execute SQL ... bizarrement les accents disparaissaient.
J'ai donc construit ces 2 fonctions génériques avec l'objet ADO recordset, qui en principe est tout aussi souple que le langage SQL. leur syntaxes:
FN_INSERT( "table", "champ1", "valeur1, [...]) as boolean
FN_UPDATE( "table", "condition where", "champ1", "valeur1", [...]) as boolean

Source / Exemple : 


' 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

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (pifou25)