Bonsoir à toutes et à tous.
J'ai un fichier Excel avec beaucoup de données et mon objectif est d'exporter ces données dans une base Access, et lorsque les données dans Excel sont mises à jour, je souhaiterais que les données dans Access soient aussi mises à jour.
J'ai donc une macro qui fonctionne bien pour la création, mais pour la modification, j'ai une erreur qui apparait et qui bloque le reste de la macro.
Voici le code en question:
Comment faire pour qu'il n'y ait pas d'erreur?
Merci de votre retour.
Matt
J'ai un fichier Excel avec beaucoup de données et mon objectif est d'exporter ces données dans une base Access, et lorsque les données dans Excel sont mises à jour, je souhaiterais que les données dans Access soient aussi mises à jour.
J'ai donc une macro qui fonctionne bien pour la création, mais pour la modification, j'ai une erreur qui apparait et qui bloque le reste de la macro.
Voici le code en question:
Code:
Private Sub TRANSPOSEACCESS()
On Error GoTo myEnd
' exports data from the active worksheet to a table in an Access database this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & "Data Source=C:\Users\Emilie\Desktop\DANWARE.accdb;Persist Security Info=False;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "T_POSE", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 2 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Chantier") = Range("A" & r).Value
.Fields("Zone") = Range("B" & r).Value
.Fields("Prestation") = Range("C" & r).Value
.Fields("Unite") = Range("D" & r).Value
.Fields("Qte") = Range("E" & r).Value
.Fields("PU") = Range("F" & r).Value
.Fields("TotalNet") = Range("G" & r).Value
.Fields("Qui") = Range("H" & r).Value
.Fields("Type") = Range("I" & r).Value
.Fields("Avct") = Range("J" & r).Value
.Fields("DatePose") = Range("K" & r).Value
.Fields("QteAvct") = Range("L" & r).Value
.Fields("MontantAvctNet") = Range("M" & r).Value
.Fields("Notes") = Range("N" & r).Value
.Fields("QteBase") = Range("O" & r).Value
.Fields("FactureST") = Range("P" & r).Value
.Fields("DateFactureST") = Range("Q" & r).Value
.Fields("NumFactureST") = Range("R" & r).Value
.Fields("XLSBDID") = Range("S" & r).Value
' .Fields("DevisDetailID") = Range("H" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
myEnd:
Sheets("EXPORT").Select
Dim cnx As ADODB.Connection, rsx As ADODB.Recordset, rx As Long
Dim cd As New ADODB.Command
' connect to the Access database
Set cnx = New ADODB.Connection
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & "Data Source=C:\Users\Emilie\Desktop\DANWARE.accdb;Persist Security Info=False;"
' open a recordset
Set rsx = New ADODB.Recordset
rsx.Open "T_POSE", cnx, adOpenKeyset, adLockOptimistic, adCmdTable
cd.ActiveConnection = cnx
rx = 2 ' the start row in the worksheet
Do While Len(Range("A" & rx).Formula) > 0
' repeat until firsxt empty cell in column A
With rsx
cd.CommandText = "UPDATE [T_POSE] SET [Chantier] = '" & Range("A" & rx).Value & "',[Zone] = '" & Range("B" & rx).Value & "',[Prestation] = '" & Range("C" & rx).Value & "',[Unite] = '" & Range("D" & rx).Value & "',[Qte] = '" & Range("E" & rx).Value & "',[PU] = '" & Range("F" & rx).Value & "',[TotalNet] = '" & Range("G" & rx).Value & "',[Qui] = '" & Range("H" & rx).Value & "',[Type] = '" & Range("I" & rx).Value & "',[Avct] = '" & Range("J" & rx).Value & "',[DatePose] = '" & Range("K" & rx).Value & "', [QteAvct] = '" & Range("L" & rx).Value & "',[MontantAvctNet] = '" & Range("M" & rx).Value & "',[Notes] = '" & Range("N" & rx).Value & "',[QteBase] = '" & Range("O" & rx).Value & "',[FactureST] = '" & Range("P" & rx).Value & "',[DateFactureST] = '" & Range("Q" & rx).Value & "',[NumFactureST] = '" & Range("R" & rx).Value & "',[XLSBDID] = '" & Range("Q" & rx).Value & "' WHERE [XLSBDID] = '" & Range("S" & rx).Value & "'"
cd.Execute
' MsgBox (cd.CommandText) 'debug
End With
rx = rx + 1 ' next row
Loop
rsx.Close
Set rsx = Nothing
cnx.Close
Set cnx = Nothing
End SubComment faire pour qu'il n'y ait pas d'erreur?
Merci de votre retour.
Matt
