XL 2016 Extraire une chaine de caratère avant un symbole en VBA

[GuillaumeTenim]

Bonjour à tous,

Je n'ai pas réussi à trouver la solution en écumant le net alors je m'en remets à vous. Je remplis des cellules Excel grace au GetOpenfilename. Jusque là tout se passe bien. Mais lorsque je veux extraire qu'une partie de la chaine de caractère, c'est la que tout se corse. Mon code est le suivant ; je l'ai simplifié pour la démonstration mais le résultat est le même.

Sub Test()
NomFichier="C:\Users\AGKY002\Documents\PE004-2G - Plan EXE Plomberie - RDC.pdf"
Extraction = Right(NomFichier, InStr(NomFichier, "\"))
MsgBox Extraction
End Sub

Je cherche à extraire automatiquement "PE004-2G - Plan EXE Plomberie - RDC.pdf" mais le problème c'est que mon code ne me sort que "pdf". L'extraction peut être plus ou moins longue, c'est pour cela que je dois utiliser "\" comme marqueur.

Quelqu'un aurait-il une solution.

Bien à vous.

 

[soan]

Bonsoir Guillaume,

bienvenue sur le site XLD !

dans un exo de ce genre, l'utilisation conjointe de Right et InStr engendre des fuites...

ouvre le fichier ci-dessous, et fais Ctrl t ➯ "PE004-2G - Plan EXE Plomberie - RDC.pdf"

Option Explicit

Sub Test()
  Dim NomFichier$, chn$, p%
  NomFichier = "C:\Users\AGKY002\Documents\PE004-2G - Plan EXE Plomberie - RDC.pdf"
  p = InStrRev(NomFichier, "\"): chn = Mid$(NomFichier, p + 1): MsgBox chn
End Sub

soan

 

[mapomme]

Bonsoir @GuillaumeTenim , @soan ,

Une autre pour la route...

Sub Test2()
  Dim NomFichier$, s
  NomFichier = "C:\Users\AGKY002\Documents\PE004-2G - Plan EXE Plomberie - RDC.pdf"
  s = Split(NomFichier, "\"): MsgBox s(UBound(s))     ' s(UBound(s)) contient le nom du fichier
End Sub

 

[GuillaumeTenim]

@ Soan, @ mapomme,

Mille merci à vous deux. Les deux solution fonctionnent à merveille. Je n'aurais jamais trouvé sans votre aide.

Bien à vous

 

[patricktoulon]

bonsoir à tous
celle là vous l'avez pas vu venir

Sub Test()
NomFichier = "C:\Users\AGKY002\Documents\PE004-2G - Plan EXE Plomberie - RDC.pdf"
MsgBox Dir(NomFichier)
End Sub

oserais je dire aussi qu'avec dir on a la possibilité de tester l’existence en même temps

Sub Test2()
    NomFichier = "C:\Users\AGKY002\Documents\PE004-2G - Plan EXE Plomberie - RDC.pdf"
    shortname = Dir(NomFichier)
    If shortname <> "" Then
        MsgBox shortname
    Else
        MsgBox "pete un coup ça ira mieux"
    End If
End Sub

 

[soan]

Bonjour patrick,

ta 1ère solution est très bien !

ta 2ème solution est très bien aussi, mais elle serait mieux sans la phrase de ton 2ème MsgBox : n'oublie pas qu'il y a des femmes et des enfants parmi les lecteurs de cette conversation, et c'est inutile de leur infliger « tes humeurs du moment après un plat de flageolets... ». ​

soan

 

[Magic_Doctor]

Bonjour GuillaumeTenim,

Via une fonction.

Function Extraire$(txt$)

Dim regEx As Object, mot$

    Set regEx = CreateObject("VBScript.RegExp")
    
    With regEx
        .Pattern = "(.*)\\(.*)\\(.*)\\(.*)\\((.*)\.(.*))"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(txt) Then
        mot = regEx.Replace(txt, "$5")
        Extraire = mot
    Else
        Extraire = "Not matched"
    End If
End Function

 

[Magic_Doctor]

Bonjour,

Une solution plus polyvalente, au cas où le fichier soit dans un tout autre répertoire.

Function ExtraireFinChemin$(txt$)

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

    Set regEx = CreateObject("VBScript.RegExp")
    Set wf = Application.WorksheetFunction
    NbOccurrence = (Len(txt) - Len(Replace(txt, "\", "", , , 1))) / Len("\")  'nombre de fois qu'apparaît "\" dans la chaîne "txt"
    
    With regEx
        .Pattern = wf.Rept("(.*)\\", NbOccurrence - 1) & "((.*)\.(.*))"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(txt) Then
        ExtraireFinChemin = regEx.Replace(txt, "$" & NbOccurrence + 1)
    Else
        ExtraireFinChemin = "Not matched"
    End If
End Function

Dans la PJ, c'est clair.

 

[Magic_Doctor]

Excusez-moi, une petite erreur : l'extension (.pdf) n'apparaissait plus.

Function ExtraireFinChemin$(txt$)

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

    Set regEx = CreateObject("VBScript.RegExp")
    Set wf = Application.WorksheetFunction
    NbOccurrence = (Len(txt) - Len(Replace(txt, "\", "", , , 1))) / Len("\")  'nombre de fois qu'apparaît "\" dans la chaîne "txt"
    
    With regEx
        .Pattern = wf.Rept("(.*)\\", NbOccurrence) & "((.*)\.(.*))"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(txt) Then
        ExtraireFinChemin = regEx.Replace(txt, "$" & NbOccurrence + 1)
    Else
        ExtraireFinChemin = "Not matched"
    End If
End Function

 

[patricktoulon]

Bonsoir @Magic_Doctor
en fait ton premier est très bien pas la peine de répéter plus le segment de motif
visiblement 5 est le maximum au dessus ou en dessous on revient en arriere
et même avec une chaîne de plus de 12 segment ça marche

Sub test()
MsgBox Extraire(CStr("C:\toto\titi\riri\ffifi\loulou\truc\machin\chose\bidule\pierre\pail\jacques\chouette.xlsm"))
End Sub
Function Extraire$(txt$)

Dim regEx As Object, mot$

    Set regEx = CreateObject("VBScript.RegExp")
   
    With regEx
        .Pattern = "(.*)\\(.*)\\(.*)\\(.*)\\((.*)\.(.*))"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(txt) Then
        mot = regEx.Replace(txt, "$5")
        Extraire = mot
    Else
        Extraire = "Not matched"
    End If
End Function

 

[Magic_Doctor]

Re,

Efectivement, et contre toute attente, la fonction "Extraire" marche bien même si le chemin est plus long. En revanche, si le chemin se raccourci, elle plante ("Not matched"). voir PJ.
D'autre part, je me suis rendu compte que le Pattern de la fonction "Extraire" :

.Pattern = "(.*)\\(.*)\\(.*)\\(.*)\\((.*)\.(.*))"

pouvait se simplifier par :

.Pattern = "(.*)\\(.*)\\(.*)\\(.*)\\(.*)"

pour obtenir le même résultat. Ce qui est logique.
Enfin, j'ai modifié la fonction "ExtraireFinChemin" afin d'avoir le choix entre obtenir le nom du fichier avec ou sans son extension. Là ça s'est un peu compliqué au cas où le fichier soit dans la racine (je pense qu'on peut résoudre le problème plus élégamment). Mais, pour ce faire, j'ai dû cette fois reprendre le Pattern inititial, à savoir :

.Pattern = "(.*)\\(.*)\\(.*)\\(.*)\\((.*)\.(.*))"

La fonction, "ExtraireFinChemin2" est donc la suivante :

Function ExtraireFinChemin2$(txt$, Optional chx As Boolean = True)

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

    Set regEx = CreateObject("VBScript.RegExp")
    Set wf = Application.WorksheetFunction
    NbOccurrence = (Len(txt) - Len(Replace(txt, "\", "", , , 1))) / Len("\")  'nombre de fois qu'apparaît "\" dans la chaîne "txt"
   
    With regEx
        .Pattern = wf.Rept("(.*)\\", NbOccurrence - IIf(chx, 0, 1)) & "((.*)\.(.*))"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(txt) Then
        ExtraireFinChemin2 = regEx.Replace(txt, "$" & NbOccurrence + 1)
        If NbOccurrence = 1 Then                                              'le fichier se trouve dans la racine (ex : "C:\La chèvre de M. Seguin.pdf")
            regEx.Pattern = "(.*)\\(.*)"
            ExtraireFinChemin2 = regEx.Replace(ExtraireFinChemin2, "$2")
        End If
    Else
        ExtraireFinChemin2 = "Not matched"
    End If
End Function

Ma foi, tout a l'air de maintenant bien marcher.

 

[patricktoulon]

re
après sincèrement si création d'object ,autant utiliser l'object idoine
dans le même esprit que ma version avec dir dans le sens ou là aussi on a le test d'existence en même temps

Function File_Name(NomFichier$)
    File_Name = "Not Found!"
    On Error Resume Next
    With CreateObject("Scripting.FileSystemObject").GetFile(NomFichier): File_Name = .Name: End With
End Function

Sub test()
    MsgBox File_Name("C:\Users\AGKY002\Documents\PE004-2G - Plan EXE Plomberie - RDC.pdf")
End Sub

 

[Magic_Doctor]

Re,

J'ai essayé de comprendre ce que tu as écrit, ce n'est vraiment pas clair. Il faut dire que ta prose est souvent obscure. STP, relis-toi avant de poster.
Si j'ai bien compris, il y aurait un moyen de régler ce problème autrement et infiniment plus simplement avec des sentences ad hoc que je ne connais pas. Je n'en doute pas, c'est bien pour ça que l'on va s'enrichir sur des forums.
J'ai essayé ta solution... Elle ne marche pas. En tout cas chez moi. Peut-être en raison de ma version d'Excel (2007 !!!).
Dis-moi si ta solution dans la PJ renvoie bien les résultats escomptés.

 

[patricktoulon]

re
ben oui c'est évident même si le chemin est valide grammaticalement parlant
mais que le fichier n'existe, pas tu aura "Not found!"

met dans une des cellules un chemin d'un fichier qui existe dans ton pc , tu verra ça fonctionne

comme je l'ai dit tu a le test d'existence en même temps

 

[Magic_Doctor]

Re,

Bon, maintenant c’est clair. Ta fonction renvoie le nom d’un fichier présent dans le PC, à partir de son adresse. Je viens d’essayer : YES, ça marche ! Et je n'aurais jamais su comment résoudre ce problème.

Je ne sais pas si @GuillaumeTenim voyait les choses ainsi. Personnellement, je pensais qu’il voulait extraire le nom d'un fichier contenu dans une chaîne de caractères correspondant à son adresse. D’où l’intérêt des expressions régulières pour résoudre ce problème.

Disons qu’il y eut comme un quiproquo. Quoi qu’il en soit, suivant le cas, nos fonctions apportent une réponse.

Pour le quidam qui passerait par là. Pour connaître l’adresse d’un fichier sans se prendre la tête :
« Avec l'Explorateur Windows, localisez le fichier dont vous avez besoin de copier le chemin d'accès. Pressez la touche Maj de votre clavier et, tout en la maintenant enfoncée, cliquez avec le bouton droit de la souris sur l'icône de ce fichier. Dans le menu qui s'affiche, cliquez sur Copier en tant que chemin d'accès. ».