XL 2021 extraire chaine en vba

Claudinedu13

XLDnaute Junior
Bonjour,

j'ai besoin de votre aide en vba

chaine 1 = C:\Users\claud\Classeur\???????????????

Je cherche à extraire tout ce qui se trouve après

chaine = C:\Users\claud\Classeur\

Merci
 
Solution
Spécifiez une autre expression comme position à partir de laquelle vous voulez le reste.
Si c'est toujours après un Nième "\" ça pourrait être :
VB:
Function AprèsASlh(ByVal S As String, N As Integer) As String
   AprèsASlh = Mid$(S, InStr(Replace(S, "\", " ", 1, N - 1), "\") + 1)
   End Function
Si c'est plus général prenez = Replace(ChaineComplète, ChaineDébut, "")

Claudinedu13

XLDnaute Junior
Bonsoir.
Essayez cette expression :
VB:
Mid$(Chaine1, InstrRev(Chaine1, "\") + 1)

Bonjour @Dranreb

ça m'extrait bien les caractères après le dernier \ de C:\Users\claud\Classeur\???????????????

mais la chaine à extraire est variable , et peut contenir d'autres \

C:\Users\claud\Classeur\??????\??????????\????
C:\Users\claud\Classeur\??????\?????\?????\??????????\?????
 

Dranreb

XLDnaute Barbatruc
Spécifiez une autre expression comme position à partir de laquelle vous voulez le reste.
Si c'est toujours après un Nième "\" ça pourrait être :
VB:
Function AprèsASlh(ByVal S As String, N As Integer) As String
   AprèsASlh = Mid$(S, InStr(Replace(S, "\", " ", 1, N - 1), "\") + 1)
   End Function
Si c'est plus général prenez = Replace(ChaineComplète, ChaineDébut, "")
 

Claudinedu13

XLDnaute Junior
Spécifiez une autre expression comme position à partir de laquelle vous voulez le reste.
Si c'est toujours après un Nième "\" ça pourrait être :
VB:
Function AprèsASlh(ByVal S As String, N As Integer) As String
   AprèsASlh = Mid$(S, InStr(Replace(S, "\", " ", 1, N - 1), "\") + 1)
   End Function
Si c'est plus général prenez = Replace(ChaineComplète, ChaineDébut, "")

Replace(ChaineComplète, ChaineDébut, "") convient mieux

Merci
 

jurassic pork

XLDnaute Occasionnel
Helllo,
juste pour le fun une solution avec les expressions régulières :
VB:
RegexExtract(text, pattern, Optional caseSensitive = 0) As String
Dim RegEx As Object, matches As Object
 Set RegEx = CreateObject("VBScript.RegExp")
 RegEx.pattern = pattern
 RegEx.IgnoreCase = caseSensitive
 Set matches = RegEx.Execute(text)
 If matches.Count = 1 Then RegexExtract = matches(0).SubMatches(0)
Set RegEx = Nothing : Set matches = Nothing
End Function

Sub TestRegexExtract()
  Debug.Print RegexExtract("C:\Users\claud\Classeur\tétéou\fic.txt", "Classeur\\(.*)$")
End Sub
Explication du motif Classeur\\(.*)$
On capture tous les caractères ( (.*) ) qui se trouve entre Classeur\ et la fin de la chaîne ($)
Ici cela n'offre pas d'intérêt d'utiliser les expressions régulières car on s'en sort autrement plus simplement mais si la règle de capture devient complexe on peut se tourner vers ce genre de solution.
Ami calmant, J.P
 

laurent950

XLDnaute Barbatruc
Bonjour @jurassic pork

RegEx.pattern = "[^\\]+(?=$)" ' Capture le dernier segment du chemin
RegEx.pattern = "[^\\]+(?=\\[^\\]*$)" ' Capture l'avant-dernier segment du chemin
RegEx.Pattern = "[^\\]+(?=\\[^\\]+\\[^\\]+$)" ' Pattern pour capturer l'avant-l'avant-dernier segment
RegEx.pattern = "[^\\]+\\[^\\]+$" ' Capture l'avant-dernier et le dernier segment


j'aurais plutôt écrit cela comme ca pour récurer : fic.txt

VB:
Function ExtractFileName(text As String) As String
    Dim RegEx As Object
    Dim matches As Object
 
    On Error GoTo ErrorHandler
    Set RegEx = CreateObject("VBScript.RegExp")
 
    ' Pattern pour extraire la dernière partie du chemin (fichier ou dossier)
    RegEx.IgnoreCase = True
    RegEx.pattern = "[^\\]+(?=$)" ' Capture le dernier segment du chemin
    'RegEx.pattern = "[^\\]+(?=\\[^\\]*$)" ' Capture l'avant-dernier segment du chemin
    'RegEx.pattern = "[^\\]+\\[^\\]+$" ' Capture l'avant-dernier et le dernier segment
 
    Set matches = RegEx.Execute(text)
 
    If matches.Count > 0 Then
        ' Retourner le dernier segment (fichier ou dossier)
        ExtractFileName = matches(0).Value
    Else
        ExtractFileName = "" ' Si aucun match n'est trouvé
    End If
 
    ' Libérer les objets
    Set RegEx = Nothing
    Set matches = Nothing
    Exit Function

ErrorHandler:
    ' Gestion des erreurs
    ExtractFileName = "Erreur dans l'extraction"
    Set RegEx = Nothing
    Set matches = Nothing
End Function

Sub TestExtractFileName()
    ' Test de la fonction avec un exemple
    Debug.Print ExtractFileName("C:\Users\claud\Classeur\tétéou\fic.txt") ' Retournera "fic.txt"
End Sub
 
Dernière édition:

laurent950

XLDnaute Barbatruc
Hello @jurassic pork

un Motif Easy :
regex.Pattern = "Classeur\\(.+)" ' Expression régulière pour capturer ce qui suit "Classeur\"

Hello Laurent,
ClaudineDu13 voulait récupérer ce qu'il y a après Classeur (il peut y avoir d'autres répertoires)
J'ai mis un motif facile à comprendre ;)
Ami calmant, J.P


VB:
Option Explicit
Function ExtractThirdToLastSegment(text As String) As String
'Cette fonction extrait l'avant-avant-dernier segment dans le chemin après "Classeur\"' en
'utilisant des expressions régulières.' Exemple : Pour "C:\Users\claud\Classeur\tétéou\fic.txt",
'elle 'retournera "tétéou\fic.txt".' Le motif de l'expression régulière capture tous les segments
'qui 'suivent "Classeur\".
    Dim regex As Object
    Dim matches As Object ' Ceci contiendra un MatchCollection
    Dim match As Object ' Ceci contiendra un Match
 
    On Error GoTo ErrorHandler
    Set regex = CreateObject("VBScript.RegExp")
 
    regex.IgnoreCase = True
    regex.Global = False
    regex.Pattern = "Classeur\\(.+)" ' Expression régulière pour capturer ce qui suit "Classeur\"
 
    Set matches = regex.Execute(text)
 
    If matches.Count > 0 Then
        ' Retourner l'avant-l'avant-dernier segment
        Set match = regex.Execute(text)(0)
        ExtractThirdToLastSegment = match.SubMatches(0) ' Sous-chaîne pour capturer ce qui suit "Classeur\"
    Else
        ExtractThirdToLastSegment = "" ' Si aucun match n'est trouvé
    End If
 
    ' Libérer les objets
    Set regex = Nothing
    Set matches = Nothing
    Exit Function


ErrorHandler:
    ' Gestion des erreurs
    ExtractThirdToLastSegment = "Erreur dans l'extraction"
    Set regex = Nothing
    Set matches = Nothing
End Function


Sub TestExtractThirdToLastSegment()
    ' Test de la fonction avec différents exemples
    Debug.Print ExtractThirdToLastSegment("C:\Users\claud\Classeur\tétéou\fic.txt") ' Doit retourner "tétéou\fic.txt"
    Debug.Print ExtractThirdToLastSegment("C:\Users\claud\Classeur\2???????\????????")' Doit retourner "2???????\????????"
    Debug.Print ExtractThirdToLastSegment("C:\Users\claud\Classeur\simple") ' Doit retourner "simple"
    Debug.Print ExtractThirdToLastSegment("C:\Users\claud\autre\path") ' Doit retourner "Aucune correspondance trouvée"
End Sub
 
Dernière édition:

Discussions similaires

Réponses
20
Affichages
560

Statistiques des forums

Discussions
314 626
Messages
2 111 280
Membres
111 090
dernier inscrit
ISSAKA