Hi,
I am ignorant in coding and in VBA and i am trying to copy/paste several records from several tables from a db to tables to another.
At first, the code included an "insert into" but it couldn't work due to autoincrement id. However, when i copy/paste manually, it works.
When i try to launch it, i got this message 2046: Copy command isn't avalaible now
I tried to fond solutions but none worked.
Here is the code, i m sure it's not the best one but trying to do my best! If someone could help me that would be awesome! thanks
I am ignorant in coding and in VBA and i am trying to copy/paste several records from several tables from a db to tables to another.
At first, the code included an "insert into" but it couldn't work due to autoincrement id. However, when i copy/paste manually, it works.
When i try to launch it, i got this message 2046: Copy command isn't avalaible now
I tried to fond solutions but none worked.
Here is the code, i m sure it's not the best one but trying to do my best! If someone could help me that would be awesome! thanks
Code:
Option Explicit
Private Sub btnFusionTbl_Click()
'référence : Microsoft Office xx.x Object Library pour FileDialog
On Error GoTo ErrorHandler
Dim dbsInt As DAO.Database, dbsExt As DAO.Database
Dim tdfInt As DAO.TableDef, tdfExt As DAO.TableDef
Dim fdg As Office.FileDialog
Dim strFileNameExt As String
Set dbsInt = CurrentDb ' bdd result
Set fdg = Application.FileDialog(msoFileDialogFilePicker)
With fdg
.AllowMultiSelect = False
.Title = "Selectionnez un fichier"
.InitialFileName = "C:\Users\Public\Documents\" ' emplacement des bdd base1, base2, ..., result
.Filters.Clear
.Filters.Add "Access Databases", "*.mdb, *.accdb"
If .Show = True Then
strFileNameExt = fdg.SelectedItems(1) ' bdd base1 et suivantes
Set dbsExt = OpenDatabase(strFileNameExt, True, False)
For Each tdfInt In dbsInt.TableDefs
If Not (tdfInt.Name Like "MSys*" Or tdfInt.Name Like "~*" Or tdfInt.Name Like "USys*") Then
For Each tdfExt In dbsExt.TableDefs
If Not (tdfExt.Name Like "MSys*" Or tdfExt.Name Like "~*" Or tdfExt.Name Like "USys*") Then
If tdfInt.Name = tdfExt.Name Then
DoCmd.OpenTable tdfExt.Name
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy
DoCmd.OpenTable tdfInt.Name
DoCmd.GoToRecord , , acNewRec
DoCmd.RunCommand acCmdSelectRecord
DoCmd.RunCommand acCmdPaste
DoCmd.RunCommand acCmdSaveRecord
End If
End If
Next
End If
Next
End If
End With
ExitHandler:
Exit Sub
ErrorHandler:
MsgBox "Oups ! Une erreur a été rencontrée :" & vbCrLf & "Error " & Err.Number & ": " & Err.Description
Resume ExitHandler
End Sub
Last edited: