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.
/!\ 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.
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
- Renommer fichiers
- Renommer des fichiers contenu dans un dossier - Codes sources - Visual Basic / VB.NET (Fichier / Disque)
- Copie et/ou renomme plusieurs fichiers - Codes sources - Visual Basic / VB.NET (Fichier / Disque)
- ASP / ASP.NET : Renommer un fichier à la volé - CodeS SourceS - Guide
- Renommer un fichier. - Codes sources - C# / .NET (.NET)
- Renommer plusieurs fichiers à la fois - Codes sources - Visual Basic / VB.NET (Divers)
23 juin 2011 à 15:30
Merci infiniement SlayerTFX !!
22 juin 2011 à 22:09
Je teste demain au boulot et je vous reponds ^^
Merci
Cdlt
22 juin 2011 à 21:48
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.
20 juin 2011 à 09:27
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
4 août 2006 à 11:09
# 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.