Discussion :

[Ric500]

Bonjour à tous,

Je bloque sur une export de tables dont je ne vois pas l'erreur. L'outil que je développe sert à mettre à jour une dorsale par rapport à une autre: il s'agit de la ligne "TransferDataBase" qui plante avec le message: "objet non trouvé" alors que la source est une "TableDef" d'un objet "WorkSpace" parcouru => forcément présente ?
Je précise: cette fonctionnalité a fonctionné, elle plante aujourd'hui pour la première fois.
Ci-après une copie d'écran:



Paramètres de la fonction TransferDatabase:
Source="G:\BdD\R²Gescom\Tables\R2Datae.accdb"
acTable=0
TableSource="JFeries"


Merci de me dire s'il vous manque une indication.

[marot_r]

Bonjour.

Je pense qu'il manque un point devant le DoCmd ce qu'il fait qui se rerfere a CurrentDB pas ta BD source

Essaye

Code :

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

.DoCmd.TransfertDatabase

A+

[Ric500]

Bonjour marot_r !

Avec un "." devant leDocmd, çà me renvoie l'erreur "membre de méthode ou de données introuvable" à la compil.

J'ai aussi essayé un

Code :

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

dbsSource.TransferDatabase acExport, "Microsoft Access", Source, acTable, TableSource, TableSource & "Temp"

idem

[marot_r]

OK, desole j'ai mal compris le code que j'ai lu.

As-tu essaye avec

Code :

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

DoCmd.CopyObject

https://docs.microsoft.com/en-us/off...cmd.copyobject

Ca a l'air de faire ce que tu veux.

A+

[Ric500]

Merci marot_r de ta réponse rapide,

Au risque de passer pour un boulet, il me semble que cette méthode sert à copier un objet de la base courante vers une base XY: elle n'affiche pas dans ses paramètres la base source.
Est-ce que tu penses que je devrais passer par la base courante comme "tampon"?, puis une fois l'export effectué, l'effacer ?

[Ric500]

@marot_r

J'ai utilisé "CopyObject" en passant par la base courante et çà a l'air de fonctionner:

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Private Sub Commande5_Click()
    Dim x As Integer, y  As Integer, strSQL As String
    Dim wrkDefaultSource As Workspace
    Dim wrkDefaultDest As Workspace
    Dim dbsSource As Database
    Dim dbsDest As Database
    Dim tdfloop As TableDef
    Dim TableSource As String, TableDest As String, BoolTrouve As Boolean, BoolData As Boolean
    Dim laTableSource As TableDef, laTableDest As TableDef
    Dim fldSource As Field, fldDest As Field, leChamp As Field, BoolTrouveFld As Boolean
    Set wrkDefault = DBEngine.Workspaces(0)
    Set dbsSource = wrkDefault.OpenDatabase(Source)
    Set dbsDest = wrkDefault.OpenDatabase(Destination)
    BoolTrouve = False
    BoolData = False
 
    'On Error Resume Next
 
    With dbsSource
        For x = 0 To .TableDefs.Count - 1
            TableSource = .TableDefs(x).Name
            TableDest = .TableDefs(x).Name
            '''Cherche la table dans la bd destination
            With dbsDest
                For Each tdfloop In .TableDefs
                    If tdfloop.Name = TableSource Then
                        BoolTrouve = True
                        Exit For
                        Else
                        BoolTrouve = False
                    End If
                Next tdfloop
                If BoolTrouve = False Then
                    '''Table inexistante => Import
                    BoolData = IIf(dbsSource.TableDefs(x).Properties("Description") = "Avec data", True, False)
                    If BoolData = False Then
                        DoCmd.TransferDatabase acImport, "Microsoft Access", Source, acTable, TableSource, TableSource & "Temp", True
                        Else
                        DoCmd.TransferDatabase acImport, "Microsoft Access", Source, acTable, TableSource, TableSource & "Temp", False
                    End If
                    DoCmd.CopyObject Destination, TableSource, acTable, TableSource & "Temp"
                    Call SupprimerTable(TableSource & "Temp")
                    Else
                    '''Table existante => Vérifie leur structure
                    For Each fldSource In dbsSource.TableDefs(x).Fields
                        For Each fldDest In tdfloop.Fields
                            If fldDest.Name = fldSource.Name Then
                                BoolTrouveFld = True
                                Exit For
                                Else
                                BoolTrouveFld = False
                            End If
                        Next fldDest
                        If BoolTrouveFld = True Then
                            '''Vérifie propriétés et les modifie si besoin
                            If fldDest.Type <> fldSource.Type Or fldDest.size <> fldSource.size Then
                                Call ChangeFields(Destination, TableDest, fldDest.Name, fldSource.Type, fldSource.size, fldSource.Attributes)
                            End If
                            Else
                            '''Crée champ
                            Set laTableDest = dbsDest.TableDefs(TableDest)
                            Set leChamp = laTableDest.CreateField(fldSource.Name)
                            leChamp.Type = fldSource.Type
                            leChamp.size = fldSource.size
                            leChamp.Attributes = fldSource.Attributes
                            laTableDest.Fields.Append leChamp
                        End If
 
                        BoolTrouveFld = False
                    Next fldSource
 
                End If
                BoolTrouve = False
                BoolData = False
            End With
 
TblSuite:
        Next x
    End With
 
 
    Set laTableSource = Nothing
    Set laTableDest = Nothing
    Set leChamp = Nothing
    Set dbsource = Nothing
    Set dbsDest = Nothing
    Set tdfloop = Nothing
    Set wrkDefault = Nothing
 
    '''Crée les relations à l'identique entre Source et destination
    Call CréeRelSauvegarde(Source, Destination)
End Sub

Pour ceux que çà intéresse:

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
28
29
30
31
32
33
34
35
36
Sub CréeRelSauvegarde(sour, Dest)
On Error GoTo ErrMan
Dim wrkDefault As Workspace
Set wrkDefault = DBEngine.Workspaces(0)
Dim mabdData As Database
Dim mabdSauve As Database
Dim relData As Relation
Dim relSauve As Relation
Dim fldData As Field
Dim fldSauve As Field
 
Dim leNom, Tabl, FTabl, Attrib As String
Set mabdData = wrkDefault.OpenDatabase(sour)
Set mabdSauve = wrkDefault.OpenDatabase(Dest)
With mabdData
    For Each relData In .Relations
        leNom = relData.Name
        Tabl = relData.Table
        FTabl = relData.ForeignTable
        Attrib = relData.Attributes
        Set relSauve = mabdSauve.CreateRelation(leNom, Tabl, FTabl, Attrib)
        For Each fldData In relData.Fields
            leNom = fldData.Name
            FTabl = fldData.ForeignName
            relSauve.Fields.Append relSauve.CreateField(leNom)
            relSauve.Fields(leNom).ForeignName = FTabl
        Next fldData
        mabdSauve.Relations.Append relSauve
    Next relData
End With
Fin:
Exit Sub
ErrMan:
'MsgBox (Error(err))
Resume Next
End Sub

Sert à recréer les relations entre tables dans la base de destination.
Je coince encore sur la procédure ChangeFields qui devrait me servir à mettre à jour les propriétés de champs qui auraient évolué, mais je ne désespère pas.

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub ChangeFields(nameBase, nameTbl, nameFld, typFld, sizFld, attFld)
    Dim db As Database
    Dim TD As TableDef
    Dim fld As Field
    Dim strSQL As String, leTyp As String
    Dim prop As DAO.Property
    Select Case typFld
        Case Is = 1: leTyp = "dbBoolean"
        Case Is = 2: leTyp = "dbByte"
        Case Is = 3: leTyp = "dbInteger"
        Case Is = 4: leTyp = "dbLong"
        Case Is = 5: leTyp = "dbCurrency"
        Case Is = 6: leTyp = "dbSingle"
        Case Is = 7: leTyp = "dbDouble"
        Case Is = 8: leTyp = "dbDate"
        Case Is = 9: leTyp = "dbBinary"
        Case Is = 10: leTyp = "dbText"
        Case Is = 11: leTyp = "dbLongBinary"
        Case Is = 12: leTyp = "dbMemo"
        Case Is = 15: leTyp = "dbGUID"
        Case Is = 16: leTyp = leTyp = "dbBigInt"
        Case Is = 17: leTyp = "dbVarBinary"
        Case Is = 18: leTyp = "dbChar"
        Case Is = 19: leTyp = "dbNumeric"
        Case Is = 20: leTyp = "dbDecimal"
        Case Is = 21: leTyp = "dbFloat"
        Case Is = 22: leTyp = "dbTime"
        Case Is = 23: leTyp = "dbTimeStamp"
    End Select
    Set db = DBEngine.Workspaces(0).OpenDatabase(nameBase)
    For Each TD In db.TableDefs
        If TD.Name = nameTbl Then
            For Each fld In TD.Fields
                If fld.Name = nameFld Then
                    fld.Type = typFld
                    fld.size = sizFld
                End If
            Next fld
        End If
    Next TD
    Set db = Nothing
    Set prop = Nothing
    Set fld = Nothing
End Sub

Du coup à part ce "détail", mon utilitaire de MAJ est quasiment au point. Ce post a l'air de confirmer ma signature

Merci encore, marot_r, de tes conseils avisés