Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Récurssivité non fonctionnelle

Mina12

XLDnaute Nouveau
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!

VB:
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
 

Mina12

XLDnaute Nouveau
VB:
Sub Rename()
 
  Dim dossier As String
  'dossier = InputBox("Saisissez le chemin du dossier à renommer :", "Dossier")
  dossier = "P:\Test\"
 
  '---Appelle la recherche des fichiers---.
  Rech_fichier dossier
 
  MsgBox "Terminé"
 
End Sub
 
Sub Rech_fichier(Repertoire As String)


  Dim SourceFolder As Scripting.Folder
  Dim SubFolder As Scripting.Folder
  Dim FileItem As Scripting.File
  Dim Fso As Scripting.FileSystemObject
 
  Set Fso = New Scripting.FileSystemObject
  Set SourceFolder = Fso.GetFolder(Repertoire)
 
 '--- Pour chaques fichiers dans le dossier, appelle le Renommage des fichiers puis, fichier suivant---.
  For Each FileItem In SourceFolder.Files
    RenameFile FileItem.Path
  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
 
Function RenameFile(chemin As String)
  Dim RegEx As VBScript_RegExp_55.RegExp
  Dim Matches As VBScript_RegExp_55.MatchCollection
  Dim Match As VBScript_RegExp_55.Match
  Dim Result As String
  Dim Filename As String
  Dim Repertoire As String
 
  Filename = Right(chemin, InStr(1, StrReverse(chemin), "\") - 1)         ' Récupère le nom du fichier dans repertoire grâce à la fonction strreverse qui trouve la position du \ avant le nom du fichier
  Repertoire = Replace(chemin, Filename, "")                              ' Filename = nom avec et sans chemin
 
  Set RegEx = New VBScript_RegExp_55.RegExp
  Filename = Replace(Filename, "-V", "_V")                                  ' On remplace les - par _ dans le temp
  RegEx.Pattern = "^(.+)(_V[0-9]+)\.(.+)$"                                ' Teste si le nom est formalisé
  If Not RegEx.Test(Filename) Then                                        ' Si il n'est pas formalisé :
    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)                                 ' Vérifie si le nom correspond avec me formalisme
    If (Matches(0).SubMatches(1)) = "" Then                               ' Si ça match ;
      Result = Repertoire & RegEx.Replace(Filename, "$1_V1.$3")           ' réassemble avec les morceaux trouvés et V1 car pas de numérotation
    Else                                                                  ' Si ça match pas ;
      Result = Repertoire & RegEx.Replace(Filename, "$1_V$2.$3")          ' Réassemble les morceaux en insérant le _V
    End If
    Name chemin As Result                                                 ' Nommer le nouveau chemin
  End If
 
End Function
 

patricktoulon

XLDnaute Barbatruc
re
si on considère que les noms sans suffixe numérique ne sont pas renommé
VB:
Sub test()
    MsgBox Rename("faire-un-patacaisse-100-fois-to mutch-pour-si-peu-12365")
    MsgBox Rename("faire-un-patacaisse-100-fois-to mutch-pour-si-peu")
    MsgBox Rename("faire-un-patacaisse-pour-si-peu")

End Sub

Function Rename(chaine)
    Rename = chaine
    If InStr(chaine, "-") Then
        finchaine = Mid(chaine, InStrRev(chaine, "-"))
        If finchaine Like "*-[0-9]*" And Mid(finchaine, 2) Like "*[!A-z]*" Then
            Rename = Replace(chaine, finchaine, Replace(finchaine, "-", "-V"))
        End If
    End If
End Function

si on considère que les nom sans suffixe doivent être renommé aussi avec "-V1"
Code:
Sub test()
    MsgBox Rename("faire-un-patacaisse-100-fois-to mutch-pour-si-peu-12365.xlsm")
    MsgBox Rename("faire-un-patacaisse-100-fois-to mutch-pour-si-peu.xlsm")
    MsgBox Rename("faire-un-patacaisse-pour-si-peu.xlsm")

End Sub

Function Rename(chaine)
    Dim nom$, finNom
    nom = Mid(chaine, 1, InStrRev(chaine, ".") - 1)
    ext = Mid(chaine, InStrRev(chaine, "."))
    If InStr(nom, "-") Then
        finNom = Mid(nom, InStrRev(nom, "-"))
        If finNom Like "*-[0-9]*" And Mid(finNom, 2) Like "*[!A-z]*" Then
            Rename = Replace(nom, finNom, Replace(finNom, "-", "-V")) & ext
        Else
         Rename = nom & "-V1" & ext
         End If
    Else
        Rename = nom & "-V1" & ext
    End If
End Function
 

patricktoulon

XLDnaute Barbatruc
@Dranreb

et oui beaucoup ne font pas la différence car l'object folder est permissif
c'est a dire que l'object folder renvoie un string du chemin si on utilise pas .path quand le transport par l'argumentation est en variant

c'est un sujet que nous avons abordé avec @Dudu2 l'ors de la conception de notre fonction récursive FSO ultra rapide sur un disque complet ou un gros dossier

bref comme vous l'avez vu en post précédent le regex est inutile
 

patricktoulon

XLDnaute Barbatruc
re
VB:
dim Fso As Object


Sub Rename()

    Dim dossier As String
    'dossier = InputBox("Saisissez le chemin du dossier à renommer :", "Dossier")
    'le FSO en latebinding comme ca on a pas a activer la librairie sur chaque PC ou l'on va utiliser cet object
    ' economie  d'UC:l'object est créeé une seule fois  pour toute la recherche complete du dossier racine
    If Fso Is Nothing Then Set Fso = CreateObject("Scripting.FileSystemObject")

    dossier = "P:\Test\"

    Rech_fichier dossier    '---Appelle la recherche des fichiers---.

    MsgBox "Terminé"
    
    Set Fso = Nothing' on ne detruit l'object qu'a la fin de la recherche
End Sub

Sub Rech_fichier(Repertoire As String)
    Dim SourceFolder As Object, SubFolder As Object, FileItem As Object
    Set SourceFolder = Fso.GetFolder(Repertoire)

    '--- Pour chaques fichiers dans le dossier, appelle le Renommage des fichiers puis, fichier suivant---.
    For Each FileItem In SourceFolder.Files
        RenameFile FileItem.Path
    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

Function Rename(chaine)
    Dim nom$, finNom$,ext$
    nom = Mid(chaine, 1, InStrRev(chaine, ".") - 1)
    ext = Mid(chaine, InStrRev(chaine, "."))
    If InStr(nom, "-") Then
        finNom = Mid(nom, InStrRev(nom, "-"))
        If finNom Like "*-[0-9]*" And Mid(finNom, 2) Like "*[!A-z]*" Then
            Rename = Replace(nom, finNom, Replace(finNom, "-", "-V")) & ext
        Else
            Rename = nom & IIf(Right(nom, 1) = "-", "V1", "-V1") & ext
        End If
    Else
        Rename = nom & "-V1" & ext
    End If
'facultatif si on veut changer les tiret(6) en tiret(8)
'Rename=replace(rename,"-","_")
End Function
 

patricktoulon

XLDnaute Barbatruc
@Dranreb viens voir tonton va te faire un calin moi
il y a plusieurs sorte de demandeur
ceux qui ne savent pas et là on leur donne quasiment la béquée
et ceux qui savent pas mais ont découvert des trucs intéressant comme ici le regex et campent la dessus et attendent que l'on donne la solution avec leur idée sans voir qu'il y a des solutions plus simple

de quel sorte @Mina12 fait partie (c'est a lui de décider)
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…