excel vba Récupérer le chemin du répertoire principal

Bonjour
Quand j'écris un programme, je travaille sur 3 répertoires ou disques :

• Ma clé usb (pour travailler à la maison),
• Le répertoire serveur de mon service (pour travailler avec mes collègues)
• Le répertoire utilisateur (pour les tests éventuels).

Tous les jours je synchronise les trois
Sauf que les chemins des répertoires principaux sont différents :
Pour ma clé

• A:\Mon Appli\Répertoire1
• A:\Mon Appli\Répertoire2
• A:\Mon Appli\Répertoire3...

Pour mon service

• G:\DIR20\DEP57\Sve2\Mon Appli\Répertoire1
• G:\DIR20\DEP57\Sve2\Mon Appli\Répertoire2
• G:\DIR20\DEP57\Sve2\Mon Appli\Répertoire3...

Pour les utilisateurs

• G:\DIR25\DEP5\Sve6\Mon Appli\Répertoire1
• G:\DIR25\DEP57\Sve6\Mon Appli\Répertoire2
• G:\DIR25\DEP57\Sve6\Mon Appli\Répertoire3...

je cherche un code qui me permette de récupérer le chemin du fichier ouvert jusqu'à Mon Appli, c'est à dire soit A:\Mon Appli\, soit G:\DIR20\DEP57\Sve2\Mon Appli\ soit encore G:\DIR25\DEP5\Sve6\Mon Appli\.

Ce qui me permettrait de mettre à jour facilement mes macros, surtout si "quelqu'un" décide de dépalacer Mon Appli dans un autre service ?

Merci, par avance, de votre aide

Bonjour,

Je ne suis pas certain si ça peut t'aider, mais
Thisworkbook.Path est le répertoire où se trouve l'appli...

Bonjour Mouftie, Bonjour le Forum,

Le plus efficace à mon sens est de retourner le chemin complet du fichier en shuntant les connexions réseaux.
Autrement dit, donner le chemin correspondant aux lecteurs A, G....

Pour ce faire.
Dans un nouveau module

Code:

---

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

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _ (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long Public site As String Option Compare Text   Public Function fnctGetUNCPath(ByVal PathName As String) As String   Const MAX_UNC_LENGTH As Integer = 512 Dim strUNCPath As String Dim strTempUNCName As String Dim lngReturnErrorCode As Long   strTempUNCName = String(MAX_UNC_LENGTH, 0) lngReturnErrorCode = WNetGetConnection(Left(PathName, 2), strTempUNCName, _ MAX_UNC_LENGTH)   If lngReturnErrorCode = 0 Then strTempUNCName = Trim(Left(strTempUNCName, InStr(strTempUNCName, vbNullChar) - 1)) strUNCPath = strTempUNCName & Mid(PathName, 3) End If   fnctGetUNCPath = strUNCPath End Function

---

Pour un essai

Code:

---

1 2 3 4 5 6 7

Public Sub Référence()   Dim maréf_true As String maréf_true = IIf(Len(fnctGetUNCPath(ThisWorkbook.FullName)) = 0, ThisWorkbook.FullName, fnctGetUNCPath(ThisWorkbook.FullName)) Debug.Print maréf_true   End Sub

---

Fourni par Gayot que l'on remercie.

Bnjour Parmi et Marcel
Merci de vos réponses rapides,

Parmi
Oui, je connais le code

Code:

---

Thisworkbook.Path

---

mais le fichier xlsm, ne se trouve pas directement dans le répertoire Mon Appli, mais dans un sous répertoire donc si j'applique le code, je vais avoir par exemple •G:\DIR20\DEP57\Sve2\Mon Appli\Répertoire2, or je voudrais •G:\DIR20\DEP57\Sve2\Mon Appli

Marcel,
Je n'ai pas tout compris à tes fonctions (beaucoup trop fort pour moi...), mais le résultat me donne le chemin complet, avec l'adresse sur serveur, le nom du fichier et son extension :
\\SHARED.MaSte\DONNEES\DSPM\Partage\mcg\Mon Appli\Livrable\DossierParent.xlsm

Merci

Ne t'inquiète pas. Trop fort pour moi également. C'est super Gayot qu'il faut saluer!
Le principal reste que ce code te soit utile.

Citation:

---

mais le fichier xlsm, ne se trouve pas directement dans le répertoire Mon Appli, mais dans un sous répertoire donc si j'applique le code, je vais avoir par exemple •G:\DIR20\DEP57\Sve2\Mon Appli\Répertoire2, or je voudrais •G:\DIR20\DEP57\Sve2\Mon Appli

---

Et ceci ?

Code:

---

1 2	chemin = "G:\DIR20\DEP57\Sve2\Mon Appli\Répertoire2" '=> Thisworkbook.Path MsgBox Left(chemin, InStrRev(chemin, "\"))

---

au plus simple

Code:

---

MsgBox Left(Thisworkbook.Path, InStrRev(Thisworkbook.Path, "\"))

---

Marcel,
non, ce code ne me sert pas, je voudrais retirer à Thisworkbook.Path un ou 2 sous répertoires. ta fonction est trop complète.
Merci

Merci Parmi,
c'est presque parfait... mais je pourrais faire avec.
Serait-il possible de retirer 2 sous-répertoires au lieu d'un ?
en tout cas merci, je n'avais pas pensé utiliser ces fonctions.

Salut,

Il faut adapter!
Tu peux compléter cette fonction par la méthode Split.

Le résultat en sera une variable tableau de dimension 1 que tu peux gérer à souhait

Exemple

Code:

---

1 2 3

Dim tb tb = Split(maréf_true, "\") Debug.Print tb(UBound(tb))

---

Si je peux me permettre, le but du Forum est de donner des bases.
Si le demandeur fait la démarche de les comprendre puis de les adapter, alors il en tirera plus de bénéfice qu'un simple Copier/Coller
C'est la recherche qui permet de progresser.
Du moins, c'est mon avis.

Salut,

Je viens de voir les derniers échanges.
Si tu ne veux pas utiliser la fonction citée plus haut, alors

Code:

---

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

Dim tb As Variant, i As Byte Dim lerép As String Dim nboff As Byte   tb = Split(ThisWorkbook.Path, "\") 'nombre de sous répertoires à retirer nboff = 2 lerép = "" For i = LBound(tb) To UBound(tb) - nboff lerép = lerép & "\" & tb(i) Next i Debug.Print lerép

---

bonjour

Code:

---

1 2 3 4 5

chemincomplet =thisworkbook.path parent=split(chemiconmplet,"\") newchemin=split(cheminconplet ,parent(ubound(parent)-x)(0) & thisworkbook.name   x étant l'index du parent -1 pour le plus proche et ainsi de suite

---

Merci Marcel,
j'espère que je ne t'ai pas froissé (je sais mieux repasser que coder ;>)
Je suis bien d'accord, j'essaie toujours de comprendre et d'adapter, mais là, j'ai pas tout compris et je ne connais pas du tout la méthode Split.
J'ai déjà essayé de la comprendre, mais c'était il y a un moment, je vais peut-être reessayer...
En tout cas, le tout (fonction et méthode) va me servir (même en aveugle).
Alors encore meci

Bonsoir Patrick
Bonsoir à tous
Un grand merci à tous, j'ai encore appris pleins de choses sur ce site.
J'ai maintenant tout ce qu'il me faut, jusqu'à la prochaine fois.
A bientôt donc.