Tables attachées

bonjour
tu mets le code dans un module et tu appelles la function fRefreshLinks() au démarrage
moi, je l'ai mise dans form_load du menu général, le form qui s'ouvre à l'ouverture de la base, mais tu peux mettre dans une macro
autoexec
on est bien d'accord, ici les 2 bases sont au méme endroit

Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef
Dim varRet As Variant
Dim strNewPath As String

Const cERR_USERCANCEL = vbObjectError + 1000
Const cERR_NOREMOTETABLE = vbObjectError + 2000

On Local Error GoTo fRefreshLinks_Err

'If MsgBox("Are you sure you want to reconnect all Access tables?", _
vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.RaisecERR_USERCANCEL

'Premièrement, trouver toutes les tables liées, dans la collection
Set collTbls = fGetLinkedTables

'et maintenant, les relier
Set dbCurr = CurrentDb


For i = collTbls.Count To 1 Step -1
strDBPath = fParsePath(collTbls(i))
strTbl = fParseTable(collTbls(i))
If Right(strTbl, 4) = "Text" Then
ConnectText strTbl
GoTo imi
End If
varRet = SysCmd(acSysCmdSetStatus, "Liaison de '" & strTbl & "'....")
If Left$(strDBPath, 4) = "ODBC" Then
'Tables ODBC
'les tables ODBC sont manipulées différemment
' Set tdfLocal = dbCurr.TableDefs(strTbl)
' With tdfLocal
' .Connect = pcCONNECT
' .RefreshLink
' collTbls.Remove (strTbl)
' End With
Else
If strNewPath <> vbNullString Then
'Essayer ceci en premier
strDBPath = strNewPath
Else
'If Len(Dir(strDBPath)) = 0 Then
'Le fichier n'existe pas, appeler GetOpenFileName
strDBPath = CurrentDBDir() & "data_aubry_2.mdb"

If strDBPath = vbNullString Then
'L'utilisateur annule en cliquant cancel
Err.Raise cERR_USERCANCEL
End If
'End If
End If

'la base de données d'arrière-plan existe
'On place ici, car on peut avoir plusieurs sources
'différentes
Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

'vérifier si la table est présente dans dbLink
strTbl = fParseTable(collTbls(i))
If fIsRemoteTable(dbLink, strTbl) Then
'tout est beau, on reconnecte
Set tdfLocal = dbCurr.TableDefs(strTbl)
With tdfLocal
.Connect = ";Database=" & strDBPath
.RefreshLink
collTbls.Remove (.Name)
End With
Else
Err.Raise cERR_NOREMOTETABLE
End If
End If
imi:
Next
fRefreshLinks = True
varRet = SysCmd(acSysCmdClearStatus)
'MsgBox "Toutes les tables Access sont reconnectées avec succès.", vbInformation + vbOKOnly, "Succès"
fRefreshLinks_End:
Set collTbls = Nothing
Set tdfLocal = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case Err
Case 3059:

Case cERR_USERCANCEL:
MsgBox "Aucune base de données n'est spécifiée, ne peut reconnecter les tables.", _
vbCritical + vbOKOnly, _
"Erreur en rafraîchissant les liens."
Resume fRefreshLinks_End
Case cERR_NOREMOTETABLE:
MsgBox "La table '" & strTbl & "' n'est pas trouvée dans la base de données " & _
vbCrLf & dbLink.Name & ". On ne peut rafraîchir le lien", _
vbCritical + vbOKOnly, _
"Erreur en rafraîchissant les liens."
Resume fRefreshLinks_End
Case Else:
strMsg = "Erreur..." & vbCrLf & vbCrLf
strMsg = strMsg & "Connection à la base" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
'strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Erreur"
Resume fRefreshLinks_End
End Select
End Function

Function fGetLinkedTables() As Collection
'Retourne toutes les tables liées
Dim collTables As New Collection
Dim tdf As TableDef, db As Database
Set db = CurrentDb
db.TableDefs.Refresh
For Each tdf In db.TableDefs
With tdf
If Len(.Connect) > 0 Then
'If Left$(.Connect, 4) = "ODBC" Then
' collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name
'ODBC Reconnect handled separately
'Else
collTables.Add Item:=.Name & .Connect, KEY:=.Name
'End If
End If
End With
Next
Set fGetLinkedTables = collTables
Set collTables = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
Function fParsePath(strIn As String) As String
If Left$(strIn, 4) <> "ODBC" Then
fParsePath = Right(strIn, Len(strIn) _
- (InStr(1, strIn, "DATABASE=") + 8))
Else
fParsePath = strIn
End If
End Function

Function fParseTable(strIn As String) As String
fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
End Function

Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
Dim tdf As TableDef
On Error Resume Next
Set tdf = dbRemote.TableDefs(strTbl)
fIsRemoteTable = (Err = 0)
Set tdf = Nothing
End Function
Sub ConnectText(Qui)
Dim tdfLinked As TableDef
Dim bd As Database
Dim T As String
Set bd = CurrentDb
T = Left(Qui, Len(Qui) - 5)
On Error Resume Next
bd.TableDefs.Delete T & "2"
On Error GoTo 0
On Error GoTo c_err
Set tdfLinked = bd.CreateTableDef(T & "2")

tdfLinked.Connect = "Text;DATABASE=" & CurrentDBDir()
tdfLinked.SourceTableName = T & ".txt"

bd.TableDefs.Append tdfLinked
Set bd = Nothing
bye_c_err:
Exit Sub
c_err:
MsgBox Error$
Resume bye_c_err
End Sub




--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
Access http://users.skynet.be/mpfa/
Excel http://www.excelabo.net
Site perso
http://access.cfi.free.fr
"Jean" <jorlandi@9online.fr> a écrit dans le message de news:cree94$cep$1@aphrodite.grec.isp.9tel.net...

Bonjour et bonne année à tous.

J'ai un soucis récurent dans les bases de données que je développe avec
un .mdb qui contient que les tables et un autre le traitement avec
Tables attachées. Quand je déplace ça dans un autre dossier bien sûr je
dois refaire les attaches.
N'y a t il pas moyen d'avoir un chemin relatif, à savoir qu'il cherche
toujours le fichier dans le dossier dans lequel il se trouve ? ou tout
au moins une procédure en VBA qui ferait cela tout seul ?

Merci par avance.

Bonjour Jean,

Voici ma solution http://www.logicielappui.com/tips/AccXP_LoginMDB_SQL.zip ,
je garde le chemin de la dorsale dans un fichier ini, donc si tu déplace la
frontale, les attaches se refont sans aucune intervention.


Salutations

Robert Simard
Logipro



"Jean" <jorlandi@9online.fr> a écrit dans le message de news:
cree94$cep$1@aphrodite.grec.isp.9tel.net...

Bonjour et bonne année à tous.

J'ai un soucis récurent dans les bases de données que je développe avec un
.mdb qui contient que les tables et un autre le traitement avec Tables
attachées. Quand je déplace ça dans un autre dossier bien sûr je dois
refaire les attaches.
N'y a t il pas moyen d'avoir un chemin relatif, à savoir qu'il cherche
toujours le fichier dans le dossier dans lequel il se trouve ? ou tout au
moins une procédure en VBA qui ferait cela tout seul ?

Merci par avance.