Bonjour,
Pour répondre au problème soulever dans le post...
Je souhaiterais créer dans un fichier excel 2 boutons pour exporter et importer des données vers un table acces.
J'ai adapté des codes trouver sur le net.
Pour l'importation des données, c'est ok.
L'export lui est plus compliqué car il faut gérer les "update" et les "insert" des nouvelles données.
A l'heure actuelle mon code est le suivant ( je le modifie au fur et à mesure).
L'erreur que je rencontre pour le moment est sur la ligne
Set DBX = OpenDatabase(ThisWorkbook.Path & "\" & ThisWorkbook.Name, False)
"impossible d'utiliser le fichier....; fichier en cours d'utilisation"
Pouvez-vous venir à mon secours ?
Bien à vous,
Le code complet :
Sub Mise_A_Jour_Export_Vers_Access2()
'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
'Excel vers Access
'Module VBA à insérer > Set DBX = OpenDatabase(...)
Dim DB As ADODB.Connection, DBX As Database, sDestination As String, gExpDB, sTable, idxFrom, idxTo, idxFromName, sType, gsSQLDB
Dim RS As DAO.Recordset, TableEnCour As DAO.Recordset
Dim fldLoop As Field, tdfNew As TableDef
Dim Msg, Style, Title, Response, MyString
Calculate
'On Error Resume Next
Set DBX = OpenDatabase(ThisWorkbook.Path & "\" & ThisWorkbook.Name, False)
Set TableEnCour = DBX.OpenRecordset("feuil2", dbOpenDynaset, dbSeeChanges, dbOptimistic)
sDestination = "C:\Drive\Inter\TiersTemps\Procédure achat\test.mdb"
'sConnect = ";pwd="
Set DB = New ADODB.Connection
With DB
.Provider = "Microsoft.Jet.OLEDB.4.0;"
.ConnectionTimeout = 30
.Mode = adModeShareExclusive
.Open "Data Source=T:\FICHIER DC\Book Animation PDV\AnimationPdv2017 - Test.mdb"
End With
Do Until TableEnCour.EOF
'Set RS = DB.OpenRecordset("select * FROM [Tbl_Depense_OC] WHERE ((([Tbl_ Depense_OC].[Concatener]) Like '" & TableEnCour.Fields(0).Value & "'))", db OpenDynaset, dbSeeChanges, dbOptimistic)
Set RS = DB.OpenRecordset _
("select * FROM [Tbl_Depense_OC]" & _
" WHERE (" & _
"(([Tbl_Depense_OC].[Annee]) Like '" & TableEnCour.Fields(0).Value & "')" & _
"AND " & _
"(([Tbl_Depense_OC].[Exercice]) Like '" & TableEnCour.Fields(1).Value & "') " & _
"AND " & _
"(([Tbl_Depense_OC].[Prestation]) Like '" & TableEnCour.Fields(5).Value & " ')" & _
"AND " & _
"(([Tbl_Depense_OC].[Num_Siren]) Like '" & TableEnCour.Fields(8).Value & "' )" & _
")", _
dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RS.RecordCount = 0 Then
RS.AddNew
Else
RS.Edit
End If
' Fields
'Annee (0)
'Exercice (1)
'Forfait (2)
'Ville (3)
'Detail (4)
'Prestation (5)
'Montant (6)
'Nom_Organisme (7)
'Num_Siren (8)
'Date_Saisie (9)
RS.Fields(0).Value = TableEnCour.Fields(0).Value
RS.Fields(1).Value = TableEnCour.Fields(1).Value
RS.Fields(2).Value = TableEnCour.Fields(2).Value
RS.Fields(3).Value = TableEnCour.Fields(3).Value
RS.Fields(4).Value = TableEnCour.Fields(4).Value
RS.Fields(5).Value = TableEnCour.Fields(5).Value
RS.Fields(6).Value = TableEnCour.Fields(6).Value
RS.Fields(7).Value = TableEnCour.Fields(7).Value
RS.Fields(8).Value = TableEnCour.Fields(8).Value
RS.Fields(9).Value = TableEnCour.Fields(9).Value
RS.Update
TableEnCour.MoveNext
Loop
TableEnCour.Close
DB.Close
Set DB = Nothing
Set TableEnCour = Nothing
' Inscription Date et Heure de l'export
With Sheets("Saisie_OC")
.Select
.Unprotect
.Range("G32").Value = Date
.Range("G33").Value = Time
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowUsingPivotTables:=True
End With
ActiveWorkbook.Save
Msg = "Export vers Access effectué" ' Définit le message.
Style = vbOKOnly + vbInformation + vbDefaultButton2 ' Définit les bo utons.
Title = "Mise à jour des données" ' Définit le titre.
' Affiche le message.
Response = MsgBox(Msg, Style, Title)
End Sub
Pour répondre au problème soulever dans le post...
Je souhaiterais créer dans un fichier excel 2 boutons pour exporter et importer des données vers un table acces.
J'ai adapté des codes trouver sur le net.
Pour l'importation des données, c'est ok.
L'export lui est plus compliqué car il faut gérer les "update" et les "insert" des nouvelles données.
A l'heure actuelle mon code est le suivant ( je le modifie au fur et à mesure).
L'erreur que je rencontre pour le moment est sur la ligne
Set DBX = OpenDatabase(ThisWorkbook.Path & "\" & ThisWorkbook.Name, False)
"impossible d'utiliser le fichier....; fichier en cours d'utilisation"
Pouvez-vous venir à mon secours ?
Bien à vous,
Le code complet :
Sub Mise_A_Jour_Export_Vers_Access2()
'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
'Excel vers Access
'Module VBA à insérer > Set DBX = OpenDatabase(...)
Dim DB As ADODB.Connection, DBX As Database, sDestination As String, gExpDB, sTable, idxFrom, idxTo, idxFromName, sType, gsSQLDB
Dim RS As DAO.Recordset, TableEnCour As DAO.Recordset
Dim fldLoop As Field, tdfNew As TableDef
Dim Msg, Style, Title, Response, MyString
Calculate
'On Error Resume Next
Set DBX = OpenDatabase(ThisWorkbook.Path & "\" & ThisWorkbook.Name, False)
Set TableEnCour = DBX.OpenRecordset("feuil2", dbOpenDynaset, dbSeeChanges, dbOptimistic)
sDestination = "C:\Drive\Inter\TiersTemps\Procédure achat\test.mdb"
'sConnect = ";pwd="
Set DB = New ADODB.Connection
With DB
.Provider = "Microsoft.Jet.OLEDB.4.0;"
.ConnectionTimeout = 30
.Mode = adModeShareExclusive
.Open "Data Source=T:\FICHIER DC\Book Animation PDV\AnimationPdv2017 - Test.mdb"
End With
Do Until TableEnCour.EOF
'Set RS = DB.OpenRecordset("select * FROM [Tbl_Depense_OC] WHERE ((([Tbl_ Depense_OC].[Concatener]) Like '" & TableEnCour.Fields(0).Value & "'))", db OpenDynaset, dbSeeChanges, dbOptimistic)
Set RS = DB.OpenRecordset _
("select * FROM [Tbl_Depense_OC]" & _
" WHERE (" & _
"(([Tbl_Depense_OC].[Annee]) Like '" & TableEnCour.Fields(0).Value & "')" & _
"AND " & _
"(([Tbl_Depense_OC].[Exercice]) Like '" & TableEnCour.Fields(1).Value & "') " & _
"AND " & _
"(([Tbl_Depense_OC].[Prestation]) Like '" & TableEnCour.Fields(5).Value & " ')" & _
"AND " & _
"(([Tbl_Depense_OC].[Num_Siren]) Like '" & TableEnCour.Fields(8).Value & "' )" & _
")", _
dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RS.RecordCount = 0 Then
RS.AddNew
Else
RS.Edit
End If
' Fields
'Annee (0)
'Exercice (1)
'Forfait (2)
'Ville (3)
'Detail (4)
'Prestation (5)
'Montant (6)
'Nom_Organisme (7)
'Num_Siren (8)
'Date_Saisie (9)
RS.Fields(0).Value = TableEnCour.Fields(0).Value
RS.Fields(1).Value = TableEnCour.Fields(1).Value
RS.Fields(2).Value = TableEnCour.Fields(2).Value
RS.Fields(3).Value = TableEnCour.Fields(3).Value
RS.Fields(4).Value = TableEnCour.Fields(4).Value
RS.Fields(5).Value = TableEnCour.Fields(5).Value
RS.Fields(6).Value = TableEnCour.Fields(6).Value
RS.Fields(7).Value = TableEnCour.Fields(7).Value
RS.Fields(8).Value = TableEnCour.Fields(8).Value
RS.Fields(9).Value = TableEnCour.Fields(9).Value
RS.Update
TableEnCour.MoveNext
Loop
TableEnCour.Close
DB.Close
Set DB = Nothing
Set TableEnCour = Nothing
' Inscription Date et Heure de l'export
With Sheets("Saisie_OC")
.Select
.Unprotect
.Range("G32").Value = Date
.Range("G33").Value = Time
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowUsingPivotTables:=True
End With
ActiveWorkbook.Save
Msg = "Export vers Access effectué" ' Définit le message.
Style = vbOKOnly + vbInformation + vbDefaultButton2 ' Définit les bo utons.
Title = "Mise à jour des données" ' Définit le titre.
' Affiche le message.
Response = MsgBox(Msg, Style, Title)
End Sub