Renommer fichiers

Soyez le premier à donner votre avis sur cette source.

Vue 23 957 fois - Téléchargée 782 fois

Description

Ce code permet de renommer en cascade des fichiers en fonction du nom du dossier et d'un numéro.
Il renomme également tout les fichiers des sous-dossiers et garde l'extension d'origine.

Source / Exemple :


'====Code du module:

Option Explicit
Sub Prc_LoadForm()

    F_Menu.Show

End Sub
Function Fct_Addre(ZP_Addr As String) As String
    Dim Z_PosSl As Integer
        'Détection de l'arborésence
    Z_PosSl = InStrRev(ZP_Addr, "\")
    ZP_Addr = Left$(ZP_Addr, Z_PosSl)
    Fct_Addre = ZP_Addr
    
End Function

Sub Prc_FileSearch(ZP_ADR As String)
    Dim i, Z_Count As Integer
    Dim Z_Doss1 As String
    
    With Application.FileSearch
        .NewSearch
        .Filename = "*.*"
        .LookIn = ZP_ADR
        .SearchSubFolders = True

        If .Execute(msoSortByNone) > 0 Then
            For i = 1 To .FoundFiles.Count
                    'Si on change de dossier on remet le conteur à 0
                If Left$(.FoundFiles(i), InStrRev(.FoundFiles(i), "\")) <> Z_Doss1 Then
                    Z_Count = 0
                    Z_Doss1 = Left$(.FoundFiles(i), InStrRev(.FoundFiles(i), "\"))
                End If
                
                Z_Count = Z_Count + 1
                
                Call Prc_RenameFile(Z_Count, .FoundFiles(i))
            Next i

        End If

    End With

End Sub

Sub Prc_RenameFile(Z_Count As Integer, ZP_Addr As String)
    Dim Z_Name, Z_Addr As String
    Dim Z_Ext As String
    Dim Z_NewName As String
    Dim Z_Len, Z_PosSlash As Integer

    On Error Resume Next

    Z_Name = ZP_Addr
    Z_Addr = Fct_Addre(ZP_Addr)

    If Right$(Z_Addr, 1) <> "\" Then
         Z_Addr = Z_Addr & "\"
    End If
        'Detection du dernier \ pour trouver le nom du dossier
    Z_PosSlash = InStrRev(Z_Addr, "\", Len(Z_Addr) - 1) + 1
    Z_Len = Len(Z_Addr)
        'Nouveau nom (Nom du dossier)
    Z_NewName = Mid$(Z_Addr, Z_PosSlash, Z_Len - Z_PosSlash)
        'Détection de l'extension
    Z_Ext = Right(Z_Name, Len(Z_Name) - InStrRev(Z_Name, ".") + 1)
        'Recomposition du nom du fichier et de son arborésence
        'Arborésence & Nom du dossier & _ & Extension
    Name (Z_Name) As (Z_Addr & Z_NewName & "_" & Z_Count & Z_Ext)
    
End Sub

'=======================
'====Code du formulaire:

Option Explicit

Private Sub FB_Close_Click()
    Unload F_Menu
End Sub

Private Sub FB_Dir_Click()
    FC_Name = Fct_Addre(Application.GetOpenFilename)
End Sub

Private Sub FB_Exit_Click()
    Application.Quit
End Sub

Private Sub FB_Run_Click()
    FC_Name.BackColor = vbRed
            'Test pour éviter de renommer un lecteur entier
        If Len(F_Menu.FC_Name) < 4 Then Exit Sub
        Call Prc_FileSearch(F_Menu.FC_Name)
    FC_Name.BackColor = vbGreen
End Sub

Conclusion :


/!\ Veuillez à ne pas renommer "C:\Windows" sinon vous aurez des problèmes...
/!\ Par sécurité une adresse de moins de 4 caractères envoie à la fin du programme sans traitement.

Le code n'est pas optimisé à 100% (je suis au courant)

Utilisation:
Cliquer sur le bouton "Dossier"
Selectionner un des fichiers du dossier à renommer
Valider
Cliquer sur le bouton "Renommer"
Une fois que le champs texte est vert c'est fini

NORMALEMENT tout les fichiers du dossier et des sous dossiers seront renommés avec le nom du dossier dans lequel ils se trouvent et un numéro.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Pimousse34
Messages postés
9
Date d'inscription
vendredi 3 septembre 2010
Statut
Membre
Dernière intervention
19 août 2011

23 juin 2011 à 15:30
Super !!!!

Merci infiniement SlayerTFX !!
Pimousse34
Messages postés
9
Date d'inscription
vendredi 3 septembre 2010
Statut
Membre
Dernière intervention
19 août 2011

22 juin 2011 à 22:09
Bonsoir,

Je teste demain au boulot et je vous reponds ^^

Merci

Cdlt
SlayerTFX
Messages postés
4
Date d'inscription
lundi 12 juin 2006
Statut
Membre
Dernière intervention
22 juin 2011

22 juin 2011 à 21:48
Bonsoir,
Merci pour le commentaire :)

Sur le moment je n'ai pas de meilleure idée que remplacer :
Name (Z_Name) As (Z_Addr & Z_NewName & "_" & Z_Count & Z_Ext)
par
Name (Z_Name) As (Z_Addr & Z_NewName & "_" & Right("000" & Z_Count, 3) & Z_Ext)

Ça répond à votre question ?

Cordialement.
Pimousse34
Messages postés
9
Date d'inscription
vendredi 3 septembre 2010
Statut
Membre
Dernière intervention
19 août 2011

20 juin 2011 à 09:27
Bonjour,


Je vous remercie ENORMEMENT pour ce fichier , je debute débute en VBA et franchement un grand MERCI !!

J'avais une toute petite question si c'etait possible, comment faire pour que le nom des fichiers renommé soit 001 puis 002 puis 003 au lieu de 1,2, 3 etc... ??

Cordialement

Pimousse34
SlayerTFX
Messages postés
4
Date d'inscription
lundi 12 juin 2006
Statut
Membre
Dernière intervention
22 juin 2011

4 août 2006 à 11:09
Pour ne pas renommer les fichiers des sous dossiers :
# With Application.FileSearch
# .NewSearch
# .Filename = "*.*"
# .LookIn = ZP_ADR
# .SearchSubFolders = False 'A la place de True

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.