Voil=E0 j'ai tjs des probl=E8me avec mon code pour actualiser=20
les tables de ma base grace =E0 du code.
En effet, il ne reconnait pas ma base donn=E9es.mde comme=20
valide pour l'importation il m'indique une=20
erreur : "objet non definit".
Ma base est en mde pour les tables, Faut t'il absolument=20
une base mdb pour ce code, il me met aussi un carr=E9 quand=20
j'affiche la valeur strdb est ce normal ???
je vous met mon code :
'** Actualisation des attaches de tables qui se trouve
'** dans la base de donn=E9e sp=E9cifi=E9e dans "strDb"
Dim db As Database
Dim tdf As TableDef
Dim tdfNew As TableDef
Set db =3D OpenDatabase(strDb)
For Each tdf In db.TableDefs
Set tdfNew =3D CurrentDb.TableDefs(tdf.Name)
tdfNew.Connect =3D ";DATABASE=3D" & strDb
'lerreur est ici strdb est bien d=E9finit mais=20
quand j'affiche =E7a valeur il me met g:\gp\donn=E9es.mde=20
puis un carr=E9
Err =3D 0
On Error Resume Next
tdfNew.RefreshLink
If Err <> 0 Then: ActualiserAttaches =3D False:=20
Exit Function
Next
ActualiserAttaches =3D True
End Function
'*******************************************
Bonjour Ludo, remplace "Dim db As Database" par "Dim db As Dao.Database", tu dois préciser à Access que tu travaille en DAO.
N'Ouble pas de cocher la librairie "Microsoft DAO 3.60 Object Library" dans le menu 'Outils/Références' de VBA.
Pour ta question sur Mde & Mdb, le format importe peu, pourvu que le code soit monté correctement.
A+ Jean.
ludo6625
Bonjour le code ne me met plus d'erreur mais aucun des chemin des tables n'est changé ???? :-))
Est ce que c'est parce que je ne précise pas le nom des tables à mettre à jour ????
voici le code : Function fCheckLinks() Dim rst As DAO.Recordset Set dbs = CurrentDb()
On Error Resume Next nbTbl = dbs.TableDefs.Count
For idx = 0 To nbTbl - 1 Set TblDef = dbs.TableDefs(idx) If TblDef.Attributes = dbAttachedTable Then Set rst = dbs.OpenRecordset(TblDef.Name) End If Next idx
If Err <> 0 Then fRefreshLinks End If
rst.Close dbs.Close Set rst = Nothing Set dbs = Nothing
End Function
Sub fRefreshLinks() Dim newpath As String On Error Resume Next
newpath = OpenFilebase("") For idx = 0 To nbTbl - 1 Set TblDef = dbs.TableDefs(idx) If TblDef.Connect <> "" Then TblDef.Connect = ";DATABASE=" & newpath & ";UID=;PWD=" TblDef.RefreshLink End If Next idx ' MsgBox Err If Err = 0 Then MsgBox "Modification du chemin des tables réussit !", vbInformation + vbOKOnly, "Welcome !" Exit Sub Else If MsgBox("Les Tables n'ont pas été trouvées " _ & "dans la base sélectionnée, voulez-vous essayer à nouveau ?", _ vbExclamation + vbYesNo, "Sélection non Valide") = vbNo Then dbs.Close Set dbs = Nothing Set TblDef = Nothing MsgBox "Au Revoir !", vbCritical + vbOKOnly, _ "Fermeture de l'application" DoCmd.Quit Else dbs.Close Set dbs = Nothing Set TblDef = Nothing Call fCheckLinks End If End If End Sub
Bonjour le code ne me met plus d'erreur mais aucun des
chemin des tables n'est changé ???? :-))
Est ce que c'est parce que je ne précise pas le nom des
tables à mettre à jour ????
voici le code :
Function fCheckLinks()
Dim rst As DAO.Recordset
Set dbs = CurrentDb()
On Error Resume Next
nbTbl = dbs.TableDefs.Count
For idx = 0 To nbTbl - 1
Set TblDef = dbs.TableDefs(idx)
If TblDef.Attributes = dbAttachedTable Then
Set rst = dbs.OpenRecordset(TblDef.Name)
End If
Next idx
If Err <> 0 Then
fRefreshLinks
End If
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
End Function
Sub fRefreshLinks()
Dim newpath As String
On Error Resume Next
newpath = OpenFilebase("")
For idx = 0 To nbTbl - 1
Set TblDef = dbs.TableDefs(idx)
If TblDef.Connect <> "" Then
TblDef.Connect = ";DATABASE=" & newpath
& ";UID=;PWD="
TblDef.RefreshLink
End If
Next idx
' MsgBox Err
If Err = 0 Then
MsgBox "Modification du chemin des tables réussit !",
vbInformation + vbOKOnly, "Welcome !"
Exit Sub
Else
If MsgBox("Les Tables n'ont pas été trouvées " _
& "dans la base sélectionnée, voulez-vous essayer
à nouveau ?", _
vbExclamation + vbYesNo, "Sélection non Valide")
= vbNo Then
dbs.Close
Set dbs = Nothing
Set TblDef = Nothing
MsgBox "Au Revoir !", vbCritical +
vbOKOnly, _
"Fermeture de l'application"
DoCmd.Quit
Else
dbs.Close
Set dbs = Nothing
Set TblDef = Nothing
Call fCheckLinks
End If
End If
End Sub
Bonjour le code ne me met plus d'erreur mais aucun des chemin des tables n'est changé ???? :-))
Est ce que c'est parce que je ne précise pas le nom des tables à mettre à jour ????
voici le code : Function fCheckLinks() Dim rst As DAO.Recordset Set dbs = CurrentDb()
On Error Resume Next nbTbl = dbs.TableDefs.Count
For idx = 0 To nbTbl - 1 Set TblDef = dbs.TableDefs(idx) If TblDef.Attributes = dbAttachedTable Then Set rst = dbs.OpenRecordset(TblDef.Name) End If Next idx
If Err <> 0 Then fRefreshLinks End If
rst.Close dbs.Close Set rst = Nothing Set dbs = Nothing
End Function
Sub fRefreshLinks() Dim newpath As String On Error Resume Next
newpath = OpenFilebase("") For idx = 0 To nbTbl - 1 Set TblDef = dbs.TableDefs(idx) If TblDef.Connect <> "" Then TblDef.Connect = ";DATABASE=" & newpath & ";UID=;PWD=" TblDef.RefreshLink End If Next idx ' MsgBox Err If Err = 0 Then MsgBox "Modification du chemin des tables réussit !", vbInformation + vbOKOnly, "Welcome !" Exit Sub Else If MsgBox("Les Tables n'ont pas été trouvées " _ & "dans la base sélectionnée, voulez-vous essayer à nouveau ?", _ vbExclamation + vbYesNo, "Sélection non Valide") = vbNo Then dbs.Close Set dbs = Nothing Set TblDef = Nothing MsgBox "Au Revoir !", vbCritical + vbOKOnly, _ "Fermeture de l'application" DoCmd.Quit Else dbs.Close Set dbs = Nothing Set TblDef = Nothing Call fCheckLinks End If End If End Sub
