recuperer chemin table liée

bonjour

j'ai crée une base pour mon entreprise avec base dorsale et et frontale.

Mon problème est que la base que j'ai crée doit être copier pour 2 autre site qui sont tous indépendant l'un de l'autre, chacun des sites a ces propre donnée mais ils ont tous la même base dorsale et frontale au niveau de l'architecture.

Mon problème est que je joint dans un formulaire le chemin d'accès a des images que je copier juste après grâce a ce code :

Code:

---

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

'Déclaration des variables Dim strFichier As String Dim oFD As FileDialog   'Paramètre la fenêtre Ouvrir Set oFD = Application.FileDialog(msoFileDialogOpen) With oFD 'Ajoute les filtres pour fichiers images et tous With .Filters .Clear .Add "Fichiers images", "*.jpg;*.jpeg;*.bmp;*.gif", 1 .Add "Tous", "*.*", 2 End With 'Renseignement du titre .Title = "Insérer une image" 'Ouvre l'explorateur dans le fichier 'Mes documents' du User connecté. .InitialFileName = "C:\" 'Interdit la multi sélection .AllowMultiSelect = False 'Permet de choisir le mode d'affichage dans l'explorateur (ici apperçu) .InitialView = msoFileDialogViewThumbnail 'Permet de personnaliser le bouton. .ButtonName = "Insérer"   'Affiche la fenêtre If .Show Then On Error GoTo FINI 'gestion erreur pour control importation   'Retourne un erreur si pas fichier image. Me.Image1.Picture = .SelectedItems(1) 'Vide du cadre image. Me.Image1.Picture = "" 'Extraction du nom du fichier à copier. strFichier = Mid(.SelectedItems(1), InStrRev(.SelectedItems(1), "\")) 'Copie du fichier sélectionné vers le sous dossier de la base. FileCopy .SelectedItems(1), "\\Srv_3d\3D_Informatique\ACCESBASE3D\base\images" & strFichier 'Chargement dans control du chemin de l'image (sous dossier base). Me.LOGO_INTERVENANT_EXT = "\\Srv_3d\3D_Informatique\ACCESBASE3D\base\images" & strFichier 'Rafraîchit le Formulaire. Me.Refresh

---

Mon probléme est sur chaque site le chemin d'accés au réseau varie donc voila les deux lignes qui me pose un probleme :

Code:

---

1 2 3 4

'Copie du fichier sélectionné vers le sous dossier de la base. FileCopy .SelectedItems(1), "\\Srv_3d\3D_Informatique\ACCESBASE3D\base\images" & strFichier 'Chargement dans control du chemin de l'image (sous dossier base). Me.LOGO_INTERVENANT_EXT = "\\Srv_3d\3D_Informatique\ACCESBASE3D\base\images" & strFichier

---

la base access est dans :
\\Srv_3d\3D_Informatique\ACCESBASE3D\base\
et donc les images dans :
\\Srv_3d\3D_Informatique\ACCESBASE3D\base\images

Pour chaque site on trouvera les images dans le dossier "images" qui sera dans le dossier ou l'on trouve la base.

Je souhaiterai remplace ce morceau "\\Srv_3d\3D_Informatique\ACCESBASE3D\base\" par le chemin d'accés a la base que l'on trouve dans le chemin des tables liée mais je ne sais comment faire pour récupérai le chemin d'une table liée pour l'utilité aprés?

Bonjour,

La propriété Connect de l'objet TableDef d'une table liée contient le nom complet de la base dorsale (Chemin+nom).

Voici une fonction pour en extraire le chemin

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Function GetDbPathOfLinkedTable(strLinkedTable As String) As String Dim strConn As String, strSceDBPathName As String, strSceDbPath As String Dim db As DAO.Database, tdef As DAO.TableDef Dim p1 As Long, p2 As Long, p3 As Long   Set db = CurrentDb Set tdef = db.TableDefs(strLinkedTable) If (tdef.Attributes And dbAttachedTable) = dbAttachedTable Then strConn = tdef.Connect ' Le nom complet de la base de données source commence ' après "DATABASE=" p1 = InStr(1, strConn, "DATABASE=", vbTextCompare) If p1 > 0 Then p2 = InStr(p1, strConn, ";") ' Il se termine au premier point-virgule (;) suivant ' ou à la fin de la chaîne de connexion If p2 = 0 Then p2 = Len(strConn) + 1 strSceDBPathName = Mid(strConn, p1 + 9, p2 - p1 - 9) p3 = InStrRev(strSceDBPathName, "\") strSceDbPath = Left(strSceDBPathName, p3) GetDbPathOfLinkedTable = strSceDbPath End If End If End Function

---

Si la table UneTableLiee est une table de la frontale liée à la dorsale:

Code:

---

1 2	Dim strCheminDorsale As string strCheminDorsale = GetDbPathOfLinkedTable("UneTableLiee")

---

Le chemin renvoyé par GetDbPathOfLinkedTable se termine par un "\"

A+

Merci pour ta reponse

Pour ma parti gestion des photos sa marche super bien.

J'ai voulu l'adapté a mes gestion des mises a jours mais je rencontre un probléme.

j'ai réalise un test avec ce chemin d'accés :
ma base est dans "C:\maintenance\base" donc avec ton programme
strCheminDorsale = "C:\maintenance\base\" la pas de probléme c'est normal

mais j'ai mais fichier de mise a jour qui sont dans : "C:\maintenance\mise a jour base"
j'avai fait sa : strCheminDorsale & "mise a jour base\mise_a_jour_auto.vbs"

et la je me suis apercu que dans strCheminDorsale j'avai "base\" en trop comment faire pour l'enleve de "strCheminDorsale "


Enfin pour la gestion de mes mises a jour j'utilise un fichier vbs avec le chemin d'accés au dossier "mise a jour base"
exemple :
origine = "C:\maintenance\mise a jour base"

je souhaiterai savoir si avec access on peux écrire dans le fichier vbs et modifier
origine = "C:\maintenance\mise a jour base"

Pour le modifier on reprendre le chemin "strCheminDorsale " moins "base\"

Tu aurai une idée?

bonjour,

Ça dépend si la base dorsale est toujours dans un sous-dossier "base" ou pas.

Si Oui, le dossier principal contenant le sous-dossier "base" s'obtient comme ça

Code:

---

1 2 3

Dim strCheminDorsale As string, strCheminPrincipal As String strCheminDorsale = GetDbPathOfLinkedTable("UneTableLiee") strCheminPrincipal = Replace(strCheminDorsale, "\base\", "\",,,vbTextCompare)

---

ou encore comme ça

Code:

---

1 2 3

Dim strCheminDorsale As string, strCheminPrincipal As String strCheminDorsale = GetDbPathOfLinkedTable("UneTableLiee") strCheminPrincipal = Left(strCheminDorsale, Len(strCheminDorsale)-5)

---

Sinon on utilise ".." pour remonter d'un niveau

Code:

---

1 2 3

Dim strCheminDorsale As string, strCheminPrincipal As String strCheminDorsale = GetDbPathOfLinkedTable("UneTableLiee") strCheminPrincipal = strCheminDorsale & "..\"

---

Citation:

---

je souhaiterai savoir si avec access on peux écrire dans le fichier vbs et modifier
origine = "C:\maintenance\mise a jour base"

---

Je te donne un exemple de code qui manipule un fichier texte.
Dans le fichier C:\Compacte2.vb il remplace alternativement strBD = "C:\base1.mdb" par "C:\Temp\base1.mdb" ou "C:\Temp\base1.mdb" par "C:\base1.mdb".

Code:

---

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

Dim f As Integer, strFichier As String, lngTaille As Long Dim strBuff As String Dim strFind As String, strRepl As String   strFichier = "C:\Compacte2.vbs"   f = FreeFile() Open strFichier For Input As #f lngTaille = LOF(f) strBuff = Input(lngTaille, f) Close f   strFind = "strBD = ""C:\base1.mdb""" strRepl = "strBD = ""C:\Temp\base1.mdb"""   If InStr(1, strBuff, strRepl, vbTextCompare) > 0 Then strRepl = "strBD = ""C:\base1.mdb""" strFind = "strBD = ""C:\Temp\base1.mdb""" End If   ' retire CRLF ajouté par Print #f, strBuff strBuff = Replace(strBuff, strFind, strRepl, , , vbTextCompare) If Right(strBuff, 2) = vbCrLf Then strBuff = Left(strBuff, Len(strBuff) - Len(vbCrLf)) End If   f = FreeFile() Open strFichier For Output As #f lngTaille = Len(strBuff) Print #f, strBuff Close f

---

A+

Merci pour ton aide j'ai retenu cette solution qui marche trés bien

Code:

---

1 2 3

Dim strCheminDorsale As string, strCheminPrincipal As String strCheminDorsale = GetDbPathOfLinkedTable("UneTableLiee") strCheminPrincipal = strCheminDorsale & "..\"

---

par contre pour ecrire dans le fichier vbs j'ai fait sa :

Code:

---

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

Dim strCheminDorsale As String, strCheminPrincipal As String strCheminDorsale = GetDbPathOfLinkedTable("tblAdmin") strCheminPrincipal = strCheminDorsale & "..\"     Dim f As Integer, strFichier As String, lngTaille As Long Dim strBuff As String Dim strFind As String, strRepl As String   strFichier = "C:\access_pc3d\mise_a_jour_auto.vbs"   f = FreeFile() Open strFichier For Input As #f lngTaille = LOF(f) strBuff = Input(lngTaille, f) Close f   strFind = "origine = ""origine2""" strRepl = "origine = strCheminPrincipal"     ' retire CRLF ajouté par Print #f, strBuff strBuff = Replace(strBuff, strFind, strRepl, , , vbTextCompare) If Right(strBuff, 2) = vbCrLf Then strBuff = Left(strBuff, Len(strBuff) - Len(vbCrLf)) End If f = FreeFile() Open strFichier For Output As #f lngTaille = Len(strBuff) Print #f, strBuff Close f

---

mais mon probléme est que pour cette ligne strRepl = "origine = strCheminPrincipal"

il me copier dans le fichier vbs sa : origine = strCheminPrincipal
alors que je voudrai que strCheminPrincipal soit egal au chemin que l'on trouve grace :

Code:

---

1 2 3

Dim strCheminDorsale As String, strCheminPrincipal As String strCheminDorsale = GetDbPathOfLinkedTable("tblAdmin") strCheminPrincipal = strCheminDorsale & "..\"

---

comment faire donc pour que strRepl = "origine = strCheminPrincipal" me copier origine = C:\access_pc3d

avec pour valeur de strCheminPrincipal = C:\access_pc3d

J'ai trouvé autre chose pour obtenir le chemin absolu à partir du chemin relatif (avec ..)

Code:

---

1 2 3 4 5 6 7 8

Dim strCheminDorsale As String, strCheminPrincipal As String Dim fso As Object   strCheminDorsale = GetDbPathOfLinkedTable("UneTableLiee")   Set fso = CreateObject("Scripting.FileSystemObject") strCheminPrincipal = fso.GetAbsolutePathName(strCheminDorsale & "..") & "\" Set fso = Nothing

---

Donc strCheminPrincipal contiendra "C:\maintenance\" au lieu de "C:\maintenance\base\..\" si je reprends ton exemple d'aujourd'hui 12h28.

Pour le reste, remplace

Code:

---

strRepl = "origine = strCheminPrincipal"

---

par

Code:

---

strRepl = "origine = """ & strCheminPrincipal & """"

---

A+

Merci bcp sa marche sur bien je l'ai teste en local sa marche il ne reste plus qu'a le lance sur tout les serveurs merci bcp

Sujet résolu


ps un grand merci a LedZeppII :king:

salut

j'ai un probléme avec le code en fin de compte sur les version RUNTIMES 2007 FR avec la version complete d'access sa marche super mais sa me plante sur la version runtime. Il me dis erreur quand il veux exécute le code tu as une idée du probléme?? (j'ai plante 30poste :cry:)

voila le code a probléme :

Code:

---

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

Dim strCheminDorsale As String, strCheminPrincipal As String Dim Fso As Object strCheminDorsale = GetDbPathOfLinkedTable("tblAdmin") Set Fso = CreateObject("Scripting.FileSystemObject") strCheminPrincipal = Fso.GetAbsolutePathName(strCheminDorsale & "..") & "\" Set Fso = Nothing   If VersionNo - NoVersion <> 0 Then 'mise a jour du fichier vbs avant copier de la nouvelle base Dim oFSO As Scripting.FileSystemObject Dim source As String, destination As String Set oFSO = New Scripting.FileSystemObject source = strCheminPrincipal & "mise a jour base\mise_a_jour_auto.vbs" destination = "C:\access_pc3d\mise_a_jour_auto.vbs" oFSO.CopyFile source, destination, True   Dim f As Integer, strFichier As String, lngTaille As Long Dim strBuff As String Dim strFind As String, strRepl As String   strFichier = "C:\access_pc3d\mise_a_jour_auto.vbs"   f = FreeFile() Open strFichier For Input As #f lngTaille = LOF(f) strBuff = Input(lngTaille, f) Close f   strFind = "origine = ""origine2""" strRepl = "origine = """ & strCheminPrincipal & """"   ' retire CRLF ajouté par Print #f, strBuff strBuff = Replace(strBuff, strFind, strRepl, , , vbTextCompare) If Right(strBuff, 2) = vbCrLf Then strBuff = Left(strBuff, Len(strBuff) - Len(vbCrLf)) End If f = FreeFile() Open strFichier For Output As #f lngTaille = Len(strBuff) Print #f, strBuff Close f   MsgBox "Une mise à jour de la base est disponible merci de cliquer sur ok la base va se mettre à jour"   Shell "wscript " & "C:\access_pc3d\mise_a_jour_auto.vbs" & """" Application.Quit Else Set rsAlwaysOpen = CurrentDb.OpenRecordset("tbldummy") End If

---

Désolé je ne vois pas.
J'ai testé ton code en simulant ta situation ... pas d'erreur.

Il faudrait mettre en place la gestion d'erreurs dans les procédures et les fonctions de manière à afficher le code et le descriptif de l'erreur.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub NomSub Dim .....   On Error Goto NomSub_Err   ...   NomSub_Exit: ... Exit Sub   NomSub_Err: MsgBox Err.Description, , "Erreur No '" & CStr(Err.Number) & "'" Resume NomSub_Exit End Sub

---

A+

je viens de relance ma base je n'ai plus le probléme je vais faire une mise a jour globale sur notre serveur ( par rapport a la base) et on va demain le resultat sur l'ensemble du parc je te dis au courant si j'ai a nouveau le probléme

j'ai trouve le probléme :
quand j'ouvre la base avec mes pseudo et mot de passe ( je suis administrateur ) tout marche bien

Si j'ouvre avec les droit d'un utilisateur classique il me souligne cette ligne :

Code:

---

oFSO.CopyFile source, destination, True

---

quand je regarde le code qui me souligne a en jaune ( la ligne de dessus) pour l'utilisateur simple plutot de qu'a "source" j'ai je bon chemin il me donne

source = "c:\Documents and Settings....."

alors que je doit avoir
source ="\\serveruxp\....."

donc ci je comprend sa viens qu'il n'arrive pas a lire le strCheminDorsale ou strCheminPrincipal

j'ai copier le code depuis de début

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Dim strCheminDorsale As String, strCheminPrincipal As String Dim Fso As Object strCheminDorsale = GetDbPathOfLinkedTable("tblAdmin") Set Fso = CreateObject("Scripting.FileSystemObject") strCheminPrincipal = Fso.GetAbsolutePathName(strCheminDorsale & "..") & "\" Set Fso = Nothing   If VersionNo - NoVersion <> 0 Then 'mise a jour du fichier vbs avant copier de la nouvelle base Dim oFSO As Scripting.FileSystemObject Dim source As String, destination As String Set oFSO = New Scripting.FileSystemObject source = strCheminPrincipal & "mise a jour base\mise_a_jour_auto.vbs" destination = "C:\access_pc3d\mise_a_jour_auto.vbs" oFSO.CopyFile source, destination, True

---

Donc je pense que c'est un problème de droit mais je ne trouve pas les quel tu aurai une idée??

Es-tu certain que ta table liée tblAdmin pointe bien où il faut ?
Vérifie avec le gestionnaire de tables liées.

oui la table tblAdmin pointe bien comme il faut.