Texte ExtraireFinChemin

[Magic_Doctor]

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

Deux méthodes différentes pour résoudre ce problème :

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

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

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

 

[patricktoulon]

bonsoir robert on c'est croisé

 

[Magic_Doctor]

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 :

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

 

[mapomme]

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.

 

[patricktoulon]

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

 

[mapomme]

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, "."))

 

[dysorthographie]

Bonjour,
Il suffit de contacter un point pour avoir un tableau de une ou deux valeures!

Split(fichier & ".", ".")(1)

Si le fichier comporte plusieurs points il faut poser la question a FSO.

Recherche & référence - FS0(S)

Tout ce que vous vouliez savoir sur FSOsans avoir osé le demander! 'Permet de vérifier si le répertoire dont le nom est précisé en paramêtre (Repertoires) existe. Retourne True s'il existe, sinon False Public Function Repertoires_Existe(Repertoires) Dim FSO Set FSO =...

www.excel-downloads.com

Avec Fso il est possible de savoir si le fichier existe, extraire son nom, son chemin, ses attributs etc...

 

[laurent950]

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.

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

 

[patricktoulon]

Bonjour Laurent
Perdu!!!
essaie donc avec ça
" c:\mondossier\mon soudossier\monchier.2021.08.AEF.xlsm"

 

[laurent950]

Bonsoir @patricktoulon
C'est en effet pas possible.
Laurent

 

[Bernard_XLD]

Bonjour à tous

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

Bien cordialement, @+

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