Discussion :

[popofpopof]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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?

[LedZeppII]

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 vb :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

A+

[popofpopof]

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?

[LedZeppII]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

ou encore comme ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

[popofpopof]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[LedZeppII]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

strRepl = "origine = strCheminPrincipal"

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

A+