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
| Public Function AttacheData()
Dim Db As Database, tdfLoop As TableDef
'Détecter s'il est nécessaire de rafraîchir les liens
If DLookup("Database", "MSysObjects", "Database <> null") = CheminData Then
Exit Function 'le répertoire n'a pas été changé
Else 'pour attacher les tables de data
Set Db = OpenDatabase(CheminData)
For Each tdfLoop In Db.TableDefs
'dans cette boucle, pour chaque table dans data, ...
If Left(tdfLoop.Name, 4) <> "MSys" Then '... pour les tables non système ...
DoCmd.DeleteObject acTable, tdfLoop.Name ' ... on supprime
' la table correspondante dans Soft...
' ... et réattache.
DoCmd.TransferDatabase acLink, "Microsoft Access", _
CheminData, acTable, tdfLoop.Name, tdfLoop.Name
End If
Next tdfLoop
Db.Close
End If
MsgBox "La liaison a été rétablie entre " & vbLf _
& CurrentDb.Name & vbLf & "et" & vbLf & CheminData(), vbInformation
End Function
Public Function CheminData()
' XXXsoft.mdb --> XXXdata.mdb
Dim i As Integer
i = InStr(1, CurrentDb.Name, "soft.", vbDatabaseCompare)
If i <> 0 Then
CheminData = Left(CurrentDb.Name, i - 1) & "Data." & _
Mid(CurrentDb.Name, i + 5, Len(CurrentDb.Name) - i - 4)
Else
MsgBox "Le nom de la BDD n'est pas de la forme attendue xxxxSoft.extension", vbCritical
End If
End Function |
Partager