Soyez le premier à donner votre avis sur cette source.
Snippet vu 15 884 fois - Téléchargée 23 fois
' 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
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.