Discussion :

[jmde]

Bonjour,

Je voudrais à partir d’une table tbl Adhérents créer par TransferDatabase une autre table vide tbl Adhérents AA.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
DoCmd.TransferDatabase acImport, "Microsoft Access", _ 
           path, acTable, "tbl Adhérents", "tbl Adhérents AA", True

Deux problèmes se présentent.

1) Avec AcExport une nouvelle Table "tbl Adhérents AA" toujours avec
les enregistrements et une liaison se crée sur la base dorsale. (La
nouvelle table n'est pas sur la frontale, et je ne sais pas où elle
est).

2) Avec AcImport une nouvelle table "tbl Adhérents AA" vide se crée
sur la frontale, et rien sur la dorsale.

Merci pour votre aide.

Salutations.

[Heureux-oli]

Si tu ne prends pas les enregistrements, pourquoi ne crées-tu pas les tables.

[jmde]

Bonsoir,

Oui en éffet je pourrais créer la table, mais je voudrais éviter de définir environ 30 champs différents.

Salutations

[LedZeppII]

Bonjour,

Cet exemple duplique la structure d'une table dans une base de donnée autre que celle qui exécute le code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Dim appACC As Access.Application
Dim strDB As String, strDBldb As String, blnAccQuit As Boolean

strDB = "Chemin\BaseCible.mdb"
strDBldb = Replace(strDB, ".mdb", ".ldb")
If Dir(strDBldb) = "" Then blnAccQuit = True Else blnAccQuit = False

Set appACC = GetObject(strDB)
' Supprime table "Adhérents AA" dans base cible
On Error Resume Next
appACC.DoCmd.DeleteObject acTable, "Adhérents AA"
On Error GoTo 0
' Duplique "Adhérent" dans "Adhérents AA", dans base cible
appACC.DoCmd.TransferDatabase acImport, "Microsoft Access", strDB, acTable, _
      "Adhérents", "Adhérents AA", True

If blnAccQuit Then appACC.Quit acQuitSaveAll
Set appACC = Nothing
' Supprime table "Adhérents AA" dans base en cours
On Error Resume Next
DoCmd.DeleteObject acTable, "Adhérents AA"
On Error GoTo 0
' Crée table liée dans base en cours
DoCmd.TransferDatabase acLink, "Microsoft Access", strDB, acTable, _
      "Adhérents AA", "Adhérents AA"

BaseCible.mdb est la base dorsale contenant la table Adhérents.
Le code s'exécute dans la base frontale.
Il duplique (structure seult) la table "Adhérents" dans la base dorsale, puis crée un lien dans la base frontale.

J'espère avoir correctement interprèté ce que tu désirais faire.
A+

[jmde]

Bonjour LedZeEpII,

Merci pour ton aide ça marche très bien, et à l'occasion peux-tu me donner quelques explications sur ces lignes de code (pourquoi en chage mdb par ldb et le if Dir..):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

strDBldb = Replace(strDB, ".mdb", ".ldb")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Dir(strDBldb) = "" Then blnAccQuit = True Else blnAccQuit = False

Salutations

[LedZeppII]

Bonjour jmde,

Le code regarde si il y a un fichier ayant le même nom que la base de donnée avec l'extention ldb
pour savoir si la base de données est déja ouverte.
Si elle est déjà ouverte je n'exécute pas la méthode .Quit car cela ferme l'instance d'Access déjà ouverte
si elle a été ouverte par le PC qui exécute le code.
Ce n'est pas parfait comme méthode car je ne vérifie pas quel PC a ouvert la base.

On peut peut-être remplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set appACC = GetObject(strDB)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Set appACC = CreateObject("Access.Application")
appACC.OpenCurrentDatabase strDB

et exécuter systématiquement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
appACC.Quit acQuitSaveAll
Set appACC = Nothing

Je ne sais pas trop.

A+

[jmde]

Bonsoir LepZeeppII

Très bien tes explications, elles m’ont permis de mieux comprendre le code.

Merci et à bientôt,

Salutations

[jmde]

Bonjour LepZeedII,


Je reviens sur ce fil car j’ai un petit souci. Lorsque j’ai fait des essais du code, j’ai utilisé un formulaire quelconque et cela a fonctionné correctement, malgré les modifications que j’ai faites qui consistent à garder le Nom de la table d’origine dans mon cas « tbl Adhérents » (mais vide).
Mais lorsque je l’intègre dans mon projet j’ai l'erreur « Vous avez essayé de verrouiller la table « tbl Adhérents » pendant son ouverture ….. elle est en cours d’utilisation » sur cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'--- On renomme la table tbl Adhérents AA en tbl Adhérents 
     appACC.DoCmd.Rename "tbl Adhérents", acTable, "tbl Adhérents AA"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
'--- Duplique "Adhérent" dans "Adhérents AA", dans base cible
     appACC.DoCmd.TransferDatabase acImport, "Microsoft Access", strDB, acTable, _
                                             "tbl Adhérents", "tbl Adhérents AA", True
    
'--- Supprime table "Adhérents" dans base cible
     On Error Resume Next
        appACC.DoCmd.DeleteObject acTable, "tbl Adhérents»
     On Error GoTo 0
    
'--- On renomme la table tbl Adhérents AA en tbl Adhérents 
     appACC.DoCmd.Rename "tbl Adhérents", acTable, "tbl Adhérents AA"  
   
    If blnAccQuit Then appACC.Quit acQuitSaveAll
     Set appACC = Nothing
     
'--- Supprime table "Adhérents AA" dans base en cours
     On Error Resume Next
        DoCmd.DeleteObject acTable, "tbl Adhérents AA"
     On Error GoTo 0
     
'---Crée table liée dans base en cours
    DoCmd.TransferDatabase acLink, "Microsoft Access", strDB, acTable, _
                                   "tbl Adhérents", "tbl Adhérents"

'--- Passer à la partie Importation Feuille
     DoCmd.TransferSpreadsheet acImport, _
         acSpreadsheetTypeExcel9, "tbl Adhérents", varFichier, True, strFeuille & "!A1:AD20000"

Salutations.

[LedZeppII]

Bonsoir jmde,

Est-ce que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
'--- Supprime table "Adhérents" dans base cible
     On Error Resume Next
        appACC.DoCmd.DeleteObject acTable, "tbl Adhérents»
     On Error GoTo 0

a bien supprimé la table ?
On peut enlever les deux On Error qui encadrent appACC.Docmd.DeleteObject.
Je les avais mis dans le code au cas ou la table à supprimer n'xisterait pas.
Mais là, la table existe puisque juste avant on la copie dans "tbl Adhérents AA".

Je pense que l'erreur doit se situer à cet endroit. Une requête ou un formulaire vérrouille peut-être la table.

A+

[jmde]

Bonsoir LepZeedII,

En effet l’erreur se situe à cet endroit car la « tbl Adhérents » existe toujours. C’est surement rs1 mais comment faire car il faut bien que rs1 soit activer à cet endroit ?

Au dessus du code j’ai ces lignes :

'

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
--- Ouverture de la base
     Set db = CurrentDb
 
'--- Interrogation de la tbl adhérents 
     rq = "select * From [tbl Adhérents]"
     Set rs1 = db.OpenRecordset(rq, dbOpenDynaset)
 
    If rs1.EOF Then blnCibleVide = True Else blnCibleVide = False
 
'--- Rechercher si la rs1 est vide
     If blnCibleVide Then
         blnExistePas = True
     Else
         blnExistePas = rs1.NoMatch
 
'--- Préparer la boîte de dialogue Ouvrir
      ?
'--- Personnaliser la liste déroulante Type de fichier
      ?
'--- Ouvrir la boîte de dialogue
      ?
'--- Ouverture de l'application
     Set xlApp = CreateObject("Excel.Application")
     ?
'--- Ouvrir chaque document sélectionné et le traiter
      ?

Salutations.

[LedZeppII]

Bonsoir,

essaie de refermer le recordset rs1 dès que tu n'en as plus besoin

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rs1.Close

Ou sinon teste avec Dcount et n'ouvre pas rs1 sur "tbl Adhérents"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
blnCibleVide = False
If Dcount("*", "tbl Adhérents") = 0 Then blnCibleVide = True

'--- Rechercher si la rs1 est vide
     If blnCibleVide Then
         blnExistePas = True
     Else
         blnExistePas = rs1.NoMatch

La partie en rouge n'a pas l'air de servir. Je ne vois pas de rs1.FindFirst

A+

[jmde]

Bonjour LepZeppII,

Ca y est j’ai résolu mon problème de suppression de tbl Adhérents en plaçant le code avant rs1, et en modifiant la source du formulaire qui se faisait avec tbl Adhérents, mais lorsque je lance la procédure il me donne une erreur « …. n’a pas trouver l’objet tbl Adhérents sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
'--- Interrogation de la tbl adhérents 
     rq = "select * From [tbl Adhérents]"
     Set rs1 = db.OpenRecordset(rq, dbOpenDynaset)

Je fais F8 est le code se poursuit normalement.

Par contre je n’ai pas compris pour rs1.FindFirst

Salutations

[LedZeppII]

Bonjoir jmde,

La je ne suis pas trop sûr.

Ca dépend peut-être de l'endroit où tu ouvres db avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set db = CurrentDb

Avant ou après avoir renommé la table ?

En principe si tu le fais après toutes tes manipulations sur les deux tables, db devrait avoir une 'vision' à jour des tables existantes.

Pour l'histoire du rs1.FindFirst, rs1.NoMatch est normalement utilisé pour vérifier le résultat de rs1.FindFirst.
Or je n'en voyais pas dans ton code.

A+

[jmde]

Bonsoir LepZeepII,

Ouf, enfin ça marche je vais pouvoir me pencher maintenant sur mes NumérosFamille et Regroupement.

Un grand merci pour ton aide, et ta patience.

Salutations