XL 2016 Récupérer le nom du dossier ou est stocké le classeur

AxelViens · 1 Avril 2022

Bonjour,

Je souhaiterais récupérer dans une cellule le nom du dossier ou est stocké mon classeur.

Ex :

C://User/xxx/Dossier1/Sous-Dossier1/Fichier.xlsx --> Sous-Dossier1
C://User/xxx/Dossier1/Sous-Dossier2/Sous-sous-Dossier21/Fichier.xlsx --> Sous-sous-Dossier21

J'ai essayé beaucoup de formule trouvé sur internet , mais aucune ne fonctionne chez moi ..

Si vous avez des idées..

Dudu2 · 1 Avril 2022

Je me suis trompé dans le code (trop vite et pas réfléchi).
Celui-ci devrait couvrir tous les cas:
- Pas de Path
- Path limité au Drive Windows
- Path Windows
- Path Réseau

VB:

Option Explicit

Sub a()
    MsgBox Dossier
End Sub

Function Dossier() As String
    Dim TSpl() As String
    
    'Fichier non encore enregistré
    If Len(ThisWorkbook.Path) = 0 Then
        Dossier = "N/A"
        Exit Function
    End If
    
    'Séparateur Windows "\"
    If InStr(ThisWorkbook.Path, "\") > 0 Then
        TSpl = Split(ThisWorkbook.Path, "\")
    End If
    
    'Séparateur Réseau "/"
    If InStr(ThisWorkbook.Path, "/") > 0 Then
        TSpl = Split(ThisWorkbook.Path, "/")
    End If
    
    If Not (Not TSpl) Then
        Dossier =...

Dudu2 · 1 Avril 2022

OK, probablement une histoire de "/" vs "\"

VB:

Option Explicit

Sub a()
    MsgBox Dossier
End Sub

Function Dossier() As String
    Dim TSpl() As String
   
    TSpl = Split(ThisWorkbook.Path, "\")
   
    If UBound(TSpl) = -1 Then
        TSpl = Split(ThisWorkbook.Path, "/")
    End If
   
    If UBound(TSpl) = -1 Then
        Dossier = "N/A"
    Else
        Dossier = TSpl(UBound(TSpl))
    End If
End Function

Edit: En cellule écrire: =Dossier()

AxelViens · 1 Avril 2022

Dudu2 à dit:

OK, probablement une histoire de "/" vs "\"

VB:

Option Explicit

Sub a()
    MsgBox Dossier
End Sub

Function Dossier() As String
    Dim TSpl() As String
  
    TSpl = Split(ThisWorkbook.Path, "\")
  
    If UBound(TSpl) = -1 Then
        TSpl = Split(ThisWorkbook.Path, "/")
    End If
  
    If UBound(TSpl) = -1 Then
        Dossier = "N/A"
    Else
        Dossier = TSpl(UBound(TSpl))
    End If
End Function

Edit: En cellule écrire: =Dossier()

Cela me renvoi toujours l'adresse en entière quand il est sur le cloud .. :/

Dudu2 · 1 Avril 2022

Est-ce que tu peux copier ici l'adresse entière rendue lorsque le fichier est sur le Cloud ?

AxelViens · 1 Avril 2022

Dudu2 à dit:
Est-ce que tu peux copier ici l'adresse entière rendue lorsque le fichier est sur le Cloud ?

https://pouressai-my.sharepoint.com/personnel/k_loverin_societaire_com/Documents/Bureau

Dudu2 · 1 Avril 2022

Je me suis trompé dans le code (trop vite et pas réfléchi).
Celui-ci devrait couvrir tous les cas:
- Pas de Path
- Path limité au Drive Windows
- Path Windows
- Path Réseau

VB:

Option Explicit

Sub a()
    MsgBox Dossier
End Sub

Function Dossier() As String
    Dim TSpl() As String
    
    'Fichier non encore enregistré
    If Len(ThisWorkbook.Path) = 0 Then
        Dossier = "N/A"
        Exit Function
    End If
    
    'Séparateur Windows "\"
    If InStr(ThisWorkbook.Path, "\") > 0 Then
        TSpl = Split(ThisWorkbook.Path, "\")
    End If
    
    'Séparateur Réseau "/"
    If InStr(ThisWorkbook.Path, "/") > 0 Then
        TSpl = Split(ThisWorkbook.Path, "/")
    End If
    
    If Not (Not TSpl) Then
        Dossier = TSpl(UBound(TSpl))
    Else
        Dossier = ThisWorkbook.Path
    End If
End Function

TooFatBoy · 1 Avril 2022

Bonjour,

Dudu2 à dit:
Pour info le dossier c'est User, tous les autres sont des sous-dossiers.

Ah ben non, tous les autres ne sont pas des sous-dossiers !
Si un sous-dossier n'est pas un dossier, alors un sous-sous-dossier n'est pas un sous-dossier, etc.

Sinon, je propose ça, basé sur #4 de Dranreb :

VB:

Sub test()
    MsgBox "Ce classeur est dans le dossier """ & Dossier & """"
End Sub

Function Dossier() As String
Dim TSpl() As String
    TSpl = Split(Replace(ThisWorkbook.Path, "\", "/"), "/")
    Dossier = TSpl(UBound(TSpl))
End Function

AxelViens · 1 Avril 2022

@Dudu2 Top ! Merci beaucoup

Dudu2 · 1 Avril 2022

C'est vrai qu'un Replace raccourcit bien le code.

VB:

Function Dossier() As String
    Dim TSpl() As String
    
    'Fichier non encore enregistré
    If Len(ThisWorkbook.Path) = 0 Then
        Dossier = "N/A"
        
    'Fichier avec Path Windows ou Réseau
    Else
        TSpl = Split(Replace(ThisWorkbook.Path, "\", "/"), "/")
        Dossier = TSpl(UBound(TSpl))
    End If
End Function

XL 2016 Récupérer le nom du dossier ou est stocké le classeur

AxelViens

XLDnaute Nouveau

Dudu2

Dudu2

XLDnaute Barbatruc

AxelViens

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

AxelViens

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

AxelViens

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Discussions similaires