Texte ExtraireFinChemin

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Magic_Doctor

XLDnaute Barbatruc
Renvoie, à partir du chemin d'un fichier, le nom du fichier.

Deux méthodes différentes pour résoudre ce problème :
VB:
Function ExtraireFinChemin$(chemin$, Optional chx As Boolean = True)
'*******************************************************************************************************************************
'Renvoie, à partir du chemin d'un fichier quel qu'il soit, le nom du fichier avec ou sans son extension
'Magic_Doctor

'- chemin : adresse du fichier (ex : "C:\Users\Belphégor\Lectures nocturnes\La revanche secrète de la chèvre de M. Seguin.pdf")
'- chx : si True (ou omis) --> La revanche secrète de la chèvre de M. Seguin.pdf
'        si False          --> La revanche secrète de la chèvre de M. Seguin
'*******************************************************************************************************************************

Dim regEx As Object, wf As WorksheetFunction, NbOccurrence As Byte

    Set regEx = CreateObject("VBScript.RegExp")
    Set wf = Application.WorksheetFunction
    NbOccurrence = (Len(chemin) - Len(Replace(chemin, "\", "", , , 1))) / Len("\")  'nombre de fois qu'apparaît "\" dans la chaîne "chemin"
    
    ExtraireFinChemin = "Not matched"
    
    With regEx
        .Pattern = wf.Rept("(.*)\\", NbOccurrence - IIf(chx, 0, 1)) & "((.*)\.(.*))"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(chemin) Then
        ExtraireFinChemin = regEx.Replace(chemin, "$" & NbOccurrence + 1)
        If NbOccurrence = 1 Then                                              'le fichier se trouve dans la racine (ex : "C:\La revanche secrète de la chèvre de M. Seguin.pdf")
            regEx.Pattern = "(.*)\\(.*)"
            ExtraireFinChemin = regEx.Replace(ExtraireFinChemin, "$2")
        End If
    End If
End Function
VB:
Function File_Name$(NomFichier$)
'*******************************************************************************************************************************************
'Renvoie, à partir du chemin d'un fichier qui doit se trouver obligatoirement quelque part dans le PC, le nom du fichier avec son extension
'patricktoulon

'- NomFichier : adresse du fichier (ex : "C:\Users\Belphégor\Lectures nocturnes\La revanche secrète de la chèvre de M. Seguin.pdf")
'*******************************************************************************************************************************************
    
    File_Name = "Not Found!"
    On Error Resume Next
    With CreateObject("Scripting.FileSystemObject").GetFile(NomFichier): File_Name = .Name: End With
End Function
VB:
Function File_Name2$(NomFichier$, Optional chx As Boolean = True)
'***************************************************************************************************************************************************
'Renvoie, à partir du chemin d'un fichier qui doit se trouver obligatoirement quelque part dans le PC, le nom du fichier avec ou sans son extension
'patricktoulon (modifié)

'- NomFichier : adresse du fichier (ex : "C:\Users\Belphégor\Lectures nocturnes\La revanche secrète de la chèvre de M. Seguin.pdf")
'- chx : si True (ou omis) --> La revanche secrète de la chèvre de M. Seguin.pdf
'        si False          --> La revanche secrète de la chèvre de M. Seguin
'***************************************************************************************************************************************************
    
Dim regEx As Object

    Set regEx = CreateObject("VBScript.RegExp")
    
    File_Name2 = "Not Found!"
    On Error Resume Next
    With CreateObject("Scripting.FileSystemObject").GetFile(NomFichier)
        File_Name2 = .Name
        If chx = False Then
            With regEx
                .Pattern = "(.*)\.(.*)"
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
            End With
            File_Name2 = regEx.Replace(File_Name2, "$1")
        End If
    End With
End Function
 

Pièces jointes

Bonsoir,

Merci à tous les deux. Ça s'éclaircit dans mon esprit.
Pour les curieux, je mets la fonction rectifiée et un chouïa améliorée :
VB:
Function DissectionAdresse$(ad$, chx As Byte)
'- ad : une adresse (par ex : "C:\Myrep\Zaza\Romina\Vicky\29254-liste-complete-20210503.csv")
'- chx : 1 --> le nom du fichier avec son extension : "29254-liste-complete-20210503.csv"
'        2 --> le nom du fichier sans son extension : "29254-liste-complete-20210503"
'        3 --> Chemin                               : "C:\Myrep\Zaza\Romina\Vicky"
'        4 --> Extension                            : "csv"
'        5 --> Racine                               : "C:"
'dysorthographie

Dim Fichier$, FichierPlusExt$, Chemin$, Extension$, Racine$

    FichierPlusExt = Split(ad, "\")(UBound(Split(ad, "\")))
    Chemin = Replace(ad, "\" & FichierPlusExt, "")
    Extension = Split(FichierPlusExt, ".")(1)
    Fichier = Replace(FichierPlusExt, "." & Extension, "")
    Racine = Split(ad, "\")(0)
    
    DissectionAdresse = IIf(chx = 1, FichierPlusExt, IIf(chx = 2, Fichier, IIf(chx = 3, Chemin, IIf(chx = 4, Extension, Racine))))
End Function
 
Bonjour @dysorthographie 🙂,

Pour ta démo:

Attention! Un fichier n'a pas forcément d'extension. Et dans ce cas, Split(fichier, ".")(1) plante.
De même, si une adresse de fichier comporte plusieurs ".", alors Split(fichier, ".")(1) ramène autre chose que l'extension réelle. 😉
 
Dernière édition:
Bonjour @mapomme
et oui
d'ou mon intervention depuis le début!!!! qui ai proposer de merger le test de l'existence même du fichier et d'en récupérer le nom
avec dir et FSO (c'est un 2 en un😁) en post 6
sinon instrRev sur le "\" est la meilleure solution si existence du fichier
😉
 
Re,

Pour le fun 😉:
Si le fichier n'a pas d'extension alors le calcul de l'extension abouti à une erreur.
==> extension = Mid(fichier, InStrRev(fichier, "."))
 
Bonjour,
Il suffit de contacter un point pour avoir un tableau de une ou deux valeures!
Code:
Split(fichier & ".", ".")(1)
Si le fichier comporte plusieurs points il faut poser la question a FSO.

Avec Fso il est possible de savoir si le fichier existe, extraire son nom, son chemin, ses attributs etc...
 
Dernière édition:
Bonsoir @mapomme, @dysorthographie, @patricktoulon, @Magic_Doctor

Si le fichier n'a pas d'extension alors le calcul de l'extension abouti à une erreur.
Avec une concaténation s'il n'y a pas d'extension, et fonctionne aussi avec l'extension.
* FichierPlusExt & "."
Extension = Split(FichierPlusExt & ".", ".")(1)
est plus d'erreur.

VB:
Dim Fichier$, FichierPlusExt$, Chemin$, Extension$, Racine$

    FichierPlusExt = Split(ad, "\")(UBound(Split(ad, "\")))
    Chemin = Replace(ad, "\" & FichierPlusExt, "")
    Extension = Split(FichierPlusExt & ".", ".")(1)
    Fichier = Replace(FichierPlusExt, "." & Extension, "")
    Racine = Split(ad, "\")(0)

Laurent
 
Dernière édition:
Bonjour Laurent
Perdu!!! 🤣 😉
essaie donc avec ça
" c:\mondossier\mon soudossier\monchier.2021.08.AEF.xlsm"
Well Done Reaction GIF
 
Bonjour à tous

La fonction de @Magic_Doctor du post 17 un peu modifiée.

Bien cordialement, @+
Image2.png

VB:
Function DissectionAdresse$(ByVal Ad$, Optional Chx As Byte = 1)
'- ad : une adresse (par ex : "C:\Myrep\Zaza\Romina\Vicky\29254-liste-complete-20210503.csv")
' ou une adresse réseau \\serveur01\dossier01\fichier01.xlsx
' ou une adresse web https://www.excel-downloads.com/threads/extrairefinchemin.20057796/post-20448715
'- chx : 1, par défaut --> le nom du fichier avec son extension : "29254-liste-complete-20210503.csv"
'        2 --> le nom du fichier sans son extension : "29254-liste-complete-20210503"
'        3 --> Chemin                               : "C:\Myrep\Zaza\Romina\Vicky"
'        4 --> Extension                            : "csv"
'        5 --> Racine                               : "C:"
Dim Fichier$, FichierPlusExt$, Chemin$, Extension$, Racine$, Sep$, Tab_Ad
    Sep = IIf(InStr(Ad, "/"), "/", "\")
    Tab_Ad = Split(Ad, Sep)
    FichierPlusExt = Tab_Ad(UBound(Tab_Ad))
    If Not Ad = FichierPlusExt Then
        Chemin = Replace(Ad, Sep & FichierPlusExt, "")
        If InStr(Ad, Sep & Sep) Then Racine = Tab_Ad(0) & Sep & Sep & Tab_Ad(2) Else If Mid(Ad, 2, 1) = ":" Then Racine = Left(Ad, 2)
    End If
    Extension = IIf(InStr(FichierPlusExt, "."), Split(FichierPlusExt, ".")(UBound(Split(FichierPlusExt, "."))), "")
    Fichier = Replace(FichierPlusExt, "." & Extension, "")
    DissectionAdresse = IIf(Chx = 1, FichierPlusExt, IIf(Chx = 2, Fichier, IIf(Chx = 3, Chemin, IIf(Chx = 4, Extension, Racine))))
End Function
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour