XL 2010 Récurssivité non fonctionnelle

[Mina12]

Bonjour, j'ai un programme qui permet de renommer les dossiers et sous dossiers d'un répertoire. Malheureusement la récurssivité pour changer le nom de mes sous dossiers ne fonctionne pas. Le programme en lui même est juste, pas de messages d'erreurs donc je n'arrive pas à trouver d'où vient le problème. Si quelqun a une solution.
Merci d'avance!

Sub Rename()
 Dim dossier As String
    dossier = "P:\Test\"
    
    'Appelle la procédure de recherche des fichiers
     rech_fichier dossier
 
    
    MsgBox "Terminé"
    
End Sub




Sub rech_fichier(repertoire As String)


    Dim RegEx As VBScript_RegExp_55.RegExp
    Dim Matches As VBScript_RegExp_55.MatchCollection
    Dim Match As VBScript_RegExp_55.Match
    Dim Filename As String
    Dim Result As String
    Dim Temp As String
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File


    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(repertoire)
 
    For Each FileItem In SourceFolder.Files
    
        Set RegEx = New VBScript_RegExp_55.RegExp
        Filename = Dir(repertoire & "*.*")
        Do While Filename <> ""
             Temp = Replace(Filename, "-", "_")
             RegEx.Pattern = "^(.+)(_V[0-9]+)\.(.+)$" ' Teste si le nom est formalisé
             If Not RegEx.Test(Temp) Then
               RegEx.Pattern = "^([^0-9|\.|_]+)_*([0-9]*)\.(.+)$" ' Découpe le nom pour récupérer les parties à réassembler en excluant le underscore
               Set Matches = RegEx.Execute(Temp)
               If (Matches(0).SubMatches(1)) = "" Then
                 Result = repertoire & RegEx.Replace(Temp, "$1_V1.$3") ' réassemble avec les morceaux trouvés et V1 car pas de numérotation
               Else
                 Result = repertoire & RegEx.Replace(Temp, "$1_V$2.$3") ' Réassemble les morceaux en insérant le _V
               End If
            Else
               Result = repertoire & Temp
            End If
            
            Name repertoire & Filename As Result
            Filename = Dir()
        Loop
        
    Next FileItem
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.SubFolders
        rech_fichier SubFolder.path
    Next SubFolder
    
End Sub

 

[Dranreb]

Indication: un espion sur Matches montre une propriété Count = 0. Je ne sais pas si c'est normal.

 

[Mina12]

Non je crois pas je l avais utilisé puis enlever

 

[Dranreb]

C'est Matches(0) qui ne va pas apparemment dans l'expression …

 

[Mina12]

Si j ai bien compris matches ne trouve pas le nom du fichier a cause de l utilisation simultanée de Dir et Fso

 

[Dranreb]

Non, j'ai enlevé tout ça en attendant, j'essaye juste de faire fonctionner votre RegExp auquel je ne comprends absolument rien, pour pouvoir compléter le code que je proposais au poste #2

 

[Mina12]

Vous voulez que j envoie l ancien code qui lui fonctionnait ?

 

[Dranreb]

Je préfèrerait une minuscule Function qui renvoie un Filename spécifié corrigé.

 

[Mina12]

C est justement ca que je n arrive pas à réaliser. Fin sans la récursivité, le programme et le renvoie au filename etait correct

 

[Dranreb]

Mettez ça au point, car moi j'en suis incapable :

Sub Test()
   MsgBox FilenameCorrigé("Bonjour-1234")
   End Sub
Function FilenameCorrigé(ByVal Filename As String) As String
   Dim RegEx As VBScript_RegExp_55.RegExp, Matches As VBScript_RegExp_55.MatchCollection
   On Error GoTo Er
   Set RegEx = New VBScript_RegExp_55.RegExp
   Filename = Replace(Filename, "-", "_")
   RegEx.Pattern = "^(.+)(_V[0-9]+)\.(.+)$" ' Teste si le nom est formalisé
   If Not RegEx.Test(Filename) Then
      RegEx.Pattern = "^([^0-9|\.|_]+)_*([0-9]*)\.(.+)$" ' Découpe le nom pour récupérer les parties à réassembler en excluant le underscore
      Set Matches = RegEx.Execute(Filename)
      If (Matches(0).SubMatches(1)) = "" Then
         FilenameCorrigé = RegEx.Replace(Filename, "$1_V1.$3") ' réassemble avec les morceaux trouvés et V1 car pas de numérotation
      Else
         FilenameCorrigé = RegEx.Replace(Filename, "$1_V$2.$3") ' Réassemble les morceaux en insérant le _V
         End If
   Else
      FilenameCorrigé = Filename
      End If
   Exit Function
Er: MsgBox "Err " & Err & vbLf & Err.Description, vbCritical, "FilenameCorrigé"
   Stop: Resume
   End Function

Et ensuite essayez :

Sub Rename()
   Dim FSO As New FileSystemObject
   RechFichiers FSO.GetFolder("P:\Test")
   End Sub
Private Sub RechFichiers(ByVal Fdr As Scripting.Folder)
   Dim Fle As Scripting.file
   For Each Fle In Fdr.Files
      On Error Resume Next
      Fle.Name = FilenameCorrigé(Fle.Name)
      On Error GoTo 0
      Next Fle
   For Each Fdr In Fdr.SubFolders
      RechFichiers Fdr
      Next Fdr
   End Sub

 

[patricktoulon]

Bonjour

exemple si le fichier s appelle Bonjour-1234 il programme va l appeller Bonjour_V1234

donc si j'ai bien compris on rajoute le "V" si le nom contient un tiret et une suite numérique a la fin
c'est bien ça ?
si c'est juste ça il faudra m'expliquer la nécessite de ce patacaisse de regex
un simple test like "*_[0-9]" devrait faire l'affaire

 

[Dranreb]

Réécrit comme ça FilenameCorrigé("Bonjour-1234") renvoie "Bonjour_V1234"

Function FilenameCorrigé(ByVal Filename As String) As String
   Dim TJn() As String, N As Integer
   On Error Goto Er
   TJn = Split(Replace(Filename, "-", "_"), "_")
   For N = 0 To UBound(TJn)
      If Left$(TJn(N), 1) Like "#" Then TJn(N) = "V" & TJn(N)
      Next N
   FilenameCorrigé = Join(TJn, "_")
   Exit Function
Er: MsgBox "Err " & Err & vbLf & Err.Description, vbCritical, "FilenameCorrigé"
   On Error GoTo 0: Stop: Resume
   End Function

 

[Mina12]

Réécrit comme ça FilenameCorrigé("Bonjour-1234") renvoie "Bonjour_V1234"

Function FilenameCorrigé(ByVal Filename As String) As String
   Dim TJn() As String, N As Integer
   On Error Goto Er
   TJn = Split(Replace(Filename, "-", "_"), "_")
   For N = 0 To UBound(TJn)
      If Left$(TJn(N), 1) Like "#" Then TJn(N) = "V" & TJn(N)
      Next N
   FilenameCorrigé = Join(TJn, "_")
   Exit Function
Er: MsgBox "Err " & Err & vbLf & Err.Description, vbCritical, "FilenameCorrigé"
   On Error GoTo 0: Stop: Resume
   End Function

Yes ça marche merci beaucoup

 

[Mina12]

Bonjour

donc si j'ai bien compris on rajoute le "V" si le nom contient un tiret et une suite numérique a la fin
c'est bien ça ?
si c'est juste ça il faudra m'expliquer la nécessite de ce patacaisse de regex
un simple test like "*_[0-9]" devrait faire l'affaire

Bonjour, le V est ajouté même si le fichiers'appelle Bonnjour ----> Bonjour_V1

 

[Dranreb]

Remarque: ma fonction n'est pas bonne alors. Mais un seul exemple n'est pas suffisant.
Est-ce seulement le dernier terme qui est concerné ? Doit-il être intégralement numérique ou commencer par un chiffre suffisait comme j'avais cru comprendre ?

 

[Mina12]

Dans le programme envoyé ce n’était pas seulement le dernier terme. J’ai effectué une petite modification pour que ça le soit.
Avec vos conseils je vous envoie mon programme actuel corrigé. La récursivité fonctionne ! Ce que je veux faire maintenant est remplacer les V majuscules par des minuscules et comme c est une macro qui a pour but de mettre à jour les versions d un fichier au lieu de recevoir n’importe qu’elle nombre, formater entre 0.1 et 10.10.

merci à tous pour vos conseils et programmes