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
|
Public Function ReAttachLinkedTables() As Boolean
Dim oDBFE As dao.Database
Dim oDBBE As dao.Database
Dim oTables As dao.TableDef
Dim intNbTables As Integer
Dim strTableName As String
Dim strDBPath As String
Dim T As Integer
On Error GoTo ReAttachLinkedTables_Error
'Le chemin complet de la base sur le serveur
strDBPath = GetLinkedDatabaseName()
'Il est préférable d'obtenir le chemin UNC plutôt que la lettre
'affectée au Map.
Set oDBFE = CurrentDb
Set oDBBE = DBEngine.OpenDatabase(strDBPath, False, False)
''' Supprime d'abord toutes les tables liées...
For Each oTables In oDBFE.TableDefs
strTableName = oTables.Name
If Left(strTableName, 3) = TBLPx Then
Select Case strTableName
', ....Toutes les tables locales à garder
Case "TBLParametres"
', ... Toutes les tables à lier
Case "TBLClients", "TBLCommandes"
DoCmd.DeleteObject acTable, strTableName
End Select
End If
Next oTables
''' Relie toutes les tables concernées (lues depuis la base dorsale)
For Each oTables In oDBBE.TableDefs
T = T + 1
strTableName = oTables.Name
Select Case strTableName
', ....Toutes les tables locales à garder
Case "TBLParametres"
', ... Toutes les tables à lier
Case "TBLClients", "TBLCommandes"
DoCmd.TransferDatabase acLink, "Microsoft Access", strDBPath, acTable, strTableName, strTableName
End Select
Next oTables
ReAttachLinkedTables = True
On Error GoTo 0
ReAttachLinkedTables_Exit:
If Not oDBBE Is Nothing Then oDBBE.Close
If Not oDBFE Is Nothing Then oDBFE.Close
Set oTables = Nothing
Set oDBBE = Nothing
Set oDBFE = Nothing
Exit Function
ReAttachLinkedTables_Error:
ReAttachLinkedTables = False
Resume ReAttachLinkedTables_Exit
End Function |
Partager