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

[AxelViens]

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]

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

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]

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

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]

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

 

[AxelViens]

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]

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

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]

Bonjour,

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 :

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]

@Dudu2 Top ! Merci beaucoup

 

[Dudu2]

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

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