Texte ExtraireFinChemin

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

  • ExtraireFinChemin.xlsm
    28.8 KB · Affichages: 14

Magic_Doctor

XLDnaute Barbatruc
Bonsoir Magic_Doctor,

j'comprends pas pourquoi tu fais tout c'truc compliqué avec RegExp quand y'a cette solution toute simple de patricktoulon avec Dir(). 😁 😜 c'est juste pour utiliser RegExp ? 🤔

soan
Re,

D'abord ouvre le fichier (ça coûte pas cher) et ensuite tu comprendras mieux.

2 cas de figure :
- soit on veut extraire d'une adresse, quelle qu'elle soit, le nom du fichier correspondant.
- soit on veut extraire d'une adresse, contenue impérativement dans le PC, le nom du fichier correspondant.

J'ai opté pour le premier cas. C'est mon choix !

Maintenant, essaye d'extraire le nom d'un fichier (issu d'une liste d'adresses qu'on t'a refilée) à partir de son adresse qui ne se trouve évidemment pas dans ton PC avec la solution de patricktoulon, alors bonne chance...
Ensuite, essaie de lourder l'extension du fichier (on a le droit de ne pas vouloir d'extension...) avec la solution proposée par patricktoulon, alors encore une fois bonne chance...

La solution de patricktoulon est certes intéressante mais limitée. Il avait interprété à sa manière (comme c'est bien souvent le cas) la demande de @GuillaumeTenim.
Mais si tu considères que la solution de patricktoulon est parfaite, c'est ton choix !

PS : dans les deux cas de figure mon truc fonctionne.
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour Magic_Doctor,

désolé d'avoir tardé à te répondre ; j'étais occupé par plusieurs autres choses différentes.

tu as écrit : « D'abord ouvre le fichier (ça coûte pas cher) et ensuite tu comprendras mieux. »

effectivement, j'ai été un peu vite, et je n'ai pas pris le temps d'ouvrir ton fichier ; c'est car j'y connais pas grand chose en RegExp ; mais j'ai tout d'même compris cette chose très importante : la méthode Dir(), bien qu'elle soit plus simple, ne peut pas marcher pour une adresse inexistante sur le disque dur du PC, alors que ta méthode RegExp fonctionne même si le chemin et le nom d'un fichier sont seulement dans une variable chaîne de caractères, ce qui peut être vraiment très pratique dans certains cas ! 👍 🙂

mes excuses, car j'avais mal compris ce que peut faire ta fonction ; je vote +1.

soan
 

patricktoulon

XLDnaute Barbatruc
Bonjour a tout les deux

perso je n’interprète rien
je dis seulement que mieux vaut utiliser les outils idoines qu'autre choses

en effet en ce qui concerne la récupération de nom de fichier
dans une adresse complète(fichier existant ou pas) il y a beaucoup moins lourd que le regex

puisque l'on joue avec un string
VB:
Sub test()

chemin = "C:\toto\titi\riri\fifi\loulou\truc.xlsm"

MsgBox Mid(chemin, InStrRev(chemin, "\") + 1)
'ou
MsgBox Split(chemin, "\")(UBound(Split(chemin, "\")))
'ou
MsgBox Right(chemin, Len(chemin) - InStrRev(chemin, "\"))
'ou encore plus singue
MsgBox Right(chemin, InStr(1, StrReverse(chemin), "\") - 1)

'ou encore plus fantasmagorique
MsgBox "nom = " & Replace(chemin, Mid(chemin, 1, InStrRev(chemin, "\")), "")
MsgBox "path = " & Replace(chemin, Mid(chemin, InStrRev(chemin, "\")), "")
End Sub

et a titre indicatif j'utilise seulement les outils vba dans excel et donc c'est compatible MAC


fait nous un regex pour obtenir ceci
"C:\toto"
"C:\toto\titi"
"C:\toto\titi\riri"
"C:\toto\titi\riri\fifi"
"C:\toto\titi\riri\fifi\loulou"
"C:\toto\titi\riri\fifi\loulou\truc.xlsm"

et la oui on te prendra au sérieux ;)
et ça sera certainement plus utile que celle que tu présente aujourd'hui

et quoi que même là il y a beaucoup plus simple mais bon comme tu apprécie le les expressions régulières
voila un petit truc a faire si tu t'en sent a la hauteur
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
tiens une idée puisque tu veux jouer sur les deux tableaux

VB:
Sub test2()
'test avec un fichier qui n'existe pas dans le Pc
    MsgBox File_Name3("C:\Users\polux\DeskTop\Nimportequoi.csv")    ' essaie sans test d’existence et avec extention
    MsgBox File_Name3("C:\Users\polux\DeskTop\Nimportequoi.csv", , False)    ' essaie sans test d’existence et sans  extension
    
    MsgBox File_Name3("C:\Users\polux\DeskTop\Nimportequoi.csv", True)   ' essaie avec  test d’existence

'test avec un fichier qui existe  dans le Pc
    MsgBox File_Name3("C:\Users\polux\DeskTop\c1.csv", True)    ' essaie avec test d’existence avec extension
    MsgBox File_Name3("C:\Users\polux\DeskTop\c1.csv", True, False)    ' essaie avec test d’existence et sans extension


End Sub

Function File_Name3$(chemin, Optional Avec_test_d_existence As Boolean = False, Optional WithExtension As Boolean = True)
    Dim nom$
    If Avec_test_d_existence Then
        On Error Resume Next
        With CreateObject("Scripting.FileSystemObject").GetFile(chemin): nom = .Name: End With
        If Err.Number > 0 Then File_Name3 = "Not Found!": Exit Function
    Else
        nom = Mid(chemin, InStrRev(chemin, "\") + 1)
    End If
    If WithExtension = False Then File_Name3 = Split(nom, ".")(0) Else File_Name3 = nom
End Function
 

Magic_Doctor

XLDnaute Barbatruc
Bonjour a tout les deux

perso je n’interprète rien
je dis seulement que mieux vaut utiliser les outils idoines qu'autre choses

en effet en ce qui concerne la récupération de nom de fichier
dans une adresse complète(fichier existant ou pas) il y a beaucoup moins lourd que le regex

puisque l'on joue avec un string
VB:
Sub test()

chemin = "C:\toto\titi\riri\fifi\loulou\truc.xlsm"

MsgBox Mid(chemin, InStrRev(chemin, "\") + 1)
'ou
MsgBox Split(chemin, "\")(UBound(Split(chemin, "\")))
'ou
MsgBox Right(chemin, Len(chemin) - InStrRev(chemin, "\"))
'ou encore plus singue
MsgBox Right(chemin, InStr(1, StrReverse(chemin), "\") - 1)

'ou encore plus fantasmagorique
MsgBox "nom = " & Replace(chemin, Mid(chemin, 1, InStrRev(chemin, "\")), "")
MsgBox "path = " & Replace(chemin, Mid(chemin, InStrRev(chemin, "\")), "")
End Sub

et a titre indicatif j'utilise seulement les outils vba dans excel et donc c'est compatible MAC


fait nous un regex pour obtenir ceci


et la oui on te prendra au sérieux ;)
et ça sera certainement plus utile que celle que tu présente aujourd'hui

et quoi que même là il y a beaucoup plus simple mais bon comme tu apprécie le les expressions régulières
voila un petit truc a faire si tu t'en sent a la hauteur
Re,

Décidément, chez toi c'est une maladie de toujours vouloir avoir le dernier mot. Ça se soigne ! Quoique... :rolleyes:
Quel est à l'origine le but de la fonction ? Récupérer, à partir de l'adresse d'un fichier, le nom du fichier. C'est tout !
Et toi tu voudrais qu'il en soit autrement. Autrement dit, tu voudrais que la fonction soit comme l'aurait imaginé patricktoulon.
 

David Aubert

XLDnaute Barbatruc
Administrateur
Modérateur
Bonjour à tous,

@patricktoulon et @Magic_Doctor : j'ai remarqué depuis plusieurs semaines, voir plus... que vous ne cessez de vous "invectiver" en direct sur le forum.

Je vais reprendre vos échanges et supprimer tous les messages qui vont en ce sens.
Je vous encourage d'ailleurs à le faire aussi par vous même...

Merci de traiter vos différents en privé, par email, conversations, mais de ne pas les exposer ainsi sur le forum.
Si vous ne souhaitez pas converser en privé à ce sujet, merci de vous ignorer sur le forum et de ne pas vous prendre à partie l'un et l'autre, cela n'apporte rien... au forum.
Ce sera mon seul message public sur le sujet, à votre dispo en MP pour en discuter si vous le souhaitez.

Bonne journée

David
 

Valtrase

XLDnaute Occasionnel
Salut à tous,
Pour ma part j'utilise cette petite fonction entre autres... qui est bien pratique
On peu jouer sur ce que l'on veux (32+64) ou 32 ou (8+16) etc....

VB:
'————————   ENUMS POUR FICHIEREXT   —————————————————————————————————————————————————————————————————————————————
Public Enum vaFichierExt
    efDrive = 8
    efPath = 16
    efFile = 32
    efExtension = 64
End Enum

' Procedure : FsoFileExt
' Date      : 21/03/2017
' Auteur    : Fabrice CONSTANS (MVP)
' Objectif  : Retourne l'un des ??ents suivant le chemin/fichier pass·en r??ence
' Entr?    : strCheminFichier contient le chemin et fichier
' Sortie    :
' Note      : iType = enum vaFichierExt
' Exemple   : MsgBox FsoFileExt("C:\Vid?s\Film\2 gun.avi", Extension), , "Extension du fichier s?ectionn·
' Retour    : ".Avi"
Public Function FileExtension(strCheminFichier As String, iType As vaFichierExt) As String
    Dim vRetour As String, nomfichier
'nomfichier = "C:\Users\Dad\Desktop\customUi14 défaut.xml"
    If iType And efDrive Then                              ' // Drive
        vRetour = Left(strCheminFichier, InStr(strCheminFichier, ":"))
    End If

    If iType And efPath Then                               ' // Path
        vRetour = vRetour & Mid(strCheminFichier, 3, InStrRev(strCheminFichier, "\") - 2)
    End If

    If iType And efFile Then                               ' // File name without extension
        Dim tmpFic As String
        tmpFic = Right(strCheminFichier, Len(strCheminFichier) - InStrRev(strCheminFichier, "\"))
        vRetour = vRetour & Left(tmpFic, InStrRev(tmpFic, ".") - 1)
    End If

    If iType And efExtension Then                          ' // Extension
        If iType And efFile Then vRetour = vRetour & "."   ' // ajoute un point si le nom du fichier est demand·
        vRetour = vRetour & Right(strCheminFichier, Len(strCheminFichier) - InStrRev(strCheminFichier, "."))
    End If

    FileExtension = vRetour

    End Function
 

Magic_Doctor

XLDnaute Barbatruc
Bonjour Valtrase,

Je viens d'essayer cette fonction. Elle marche très bien en tenant compte de tous les cas de figure.
 

Pièces jointes

  • ExtraireFinChemin.xlsm
    35.4 KB · Affichages: 8

Magic_Doctor

XLDnaute Barbatruc
Bonjour dysorthographie,

En effet, là c'est expéditif !
À partir de ton post#12, j'ai rédigé cette fonction :
VB:
Function DissectionAdresse(ad$, chx As Byte) As Variant
'- ad : une adresse (par ex : "C:\Myrep\Zaza\Romina\Vicky\29254-liste-complete-20210503.csv")
'- chx : 1 --> le nom du fichier : "29254-liste-complete-20210503"
'        2 --> le chemin         : "C:\Myrep\Zaza\Romina\Vicky"
'        3 --> l'extension       : "csv"
'        4 --> la racine         : "C:"
'dysorthographie

Dim fichier$, chemin$, extension$, racine$()

    fichier = Split(ad, "\")(UBound(Split(ad, "\")))
    chemin = Replace(ad, "\" & fichier, "")
    extension = Split(fichier, ".")(1)
    racine = Split(ad, "\")
 
    DissectionAdresse = IIf(chx = 1, fichier, IIf(chx = 2, chemin, IIf(chx = 3, extension, racine)))
End Function
Si je déclare la variable "racine" en tant que "String" (racine$) --> Erreur
En revanche, si je la déclare ainsi : racine$() --> ça marche et je me demande bien pourquoi.
En toute logique, je voulais déclarer cette fonction comme "String", mais à cause de racine = Split(ad, "\"), j'ai dû la déclarer comme "Variant". Et là, j'avoue, je ne comprends pas pourquoi.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour
racine = Split(ad, "\")(0)
sinon racine est un tableau et donc ne peut pas être un string
la fonction split en vba obtient un tableau de string (et cela même si la chaîne est numérique )

et (0) par ce que split créée un tableau en base 0

sinon avec InstrRev et mid c'est un peu moins lourd que split et replace
VB:
Function DissectionAdresse(ad$, chx As Byte) As Variant

    Dim fichier$, chemin$, extension$, racine

    fichier = Mid(ad, InStrRev(ad, "\") + 1)
    chemin = Mid(ad, 1, InStr(1, ad, "\" & fichier) - 1)
    extension = Mid(fichier, InStrRev(fichier, "."))
    racine = Mid(ad, 1, InStr(1, ad, "\") - 1)

    DissectionAdresse = IIf(chx = 1, fichier, IIf(chx = 2, chemin, IIf(chx = 3, extension, racine)))
End Function

Sub test()
    MsgBox DissectionAdresse("c:\toto\truc\machin\chose\bidule.xlsm", 1)
    MsgBox DissectionAdresse("c:\toto\truc\machin\chose\bidule.xlsm", 2)
    MsgBox DissectionAdresse("c:\toto\truc\machin\chose\bidule.xlsm", 3)
    MsgBox DissectionAdresse("c:\toto\truc\machin\chose\bidule.xlsm", 4)

End Sub
 

Statistiques des forums

Discussions
312 182
Messages
2 086 004
Membres
103 086
dernier inscrit
jcreant