Renommé tou les classeurs

Bonjour à tous en ce beau dimanche

J'aimerais savoir si c'est possible de renommé avec macro tous les classeurs d'un directory.

Pourquoi? car avant on les mettais dans le même dossier et pour les différenciers je mettais une lettre devant leurs noms:

T201
T202
V77
V444
Etc...

Maintenant que j'en ai trop j'ai fait des sous-dossiers dans lesquels je les ai séparés donc la première lettre de leur nom ne sert plus .

Pourais-je la supprimé autrement que de renommé ces centaines de classeurs??

Merci beaucoup

Temjeh

[_Thierry]

Bonjour Temjeh, le Forum


Attention

Ce genre de code doit toujours être manipulé avec précaution car celà va plus vite que de dire Ouf et sans alerte, et si on s'est planté de répertoire, ça peut faire un sacré sbinz !!! (imagine si tu fais tourner sous c:windows...)

Bon alors d'abord une Constante Public en Top de Module :

Option Explicit

Public Const ThePath As String = 'C:\\tes Fichiers\\le repertoire a traiter\\' '(à vérifier DEUX FOIS !!! LOL)

Ensuite je préfère procéder par une première étape de listing des fichiers qui vont être traités par le code TheRenamer, le code suivant va donc lister sur la feuille active tous les fichiers qui vont changer de nom :

Sub TheFileLister()
Dim TheFileSearcher As FileSearch
Dim I As Integer
    On Error Resume Next
    Set TheFileSearcher = Application.FileSearch
        With TheFileSearcher
        .NewSearch
        .Filename = '*.xls*'
        .LookIn = ThePath
        .SearchSubFolders = False
        .Execute msoSortByFileName, msoSortOrderAscending
            If .Execute > 0 Then
                With .FoundFiles
                For I = 1 To .Count
                Cells(I, 1).Value = ThePath & Dir(.Item(I))
                Next I
                End With
            Else
                MsgBox 'Pas de Fichier trouvé dans ' & ThePath
            End If
        End With
Set TheFileSearcher = Nothing
End Sub

Et dons enfin, une fois que l'on a vérifier la liste, TheRenamer peut entrer en action.........
NB No way To Cancel, pas possible d'annnuler

Sub TheRenamer()
Dim WB As Workbook, WS As Worksheet
Dim OldName As String, NewName As String
Dim L As Integer, X As Integer

Set WB = ThisWorkbook
    With WB
    Set WS = .Sheets('List')
    End With

L = WS.Range('A65536').End(xlUp).Row

    For X = 1 To L
        OldName = WS.Range('A' & X)
        NewName = Right(OldName, Len(OldName) - 1 - Len(ThePath))
        Name OldName As ThePath & NewName
    Next X

End Sub

Bon Dimanche
@+Thierry

WoW!!!

Merci Thierry
Effectivement c'est assez rapide et en plus la List me permet de la revérifier avant!!

Pour ceux qui vont la recopier il y a parcontre un ptit bug de points virgule et de guilmet:

Voici avec la correction et merci encore

Temjeh

Option Explicit

Public Const ThePath As String = 'C:\\Program Files....\\' '(à vérifier DEUX FOIS !!! LOL)

Sub TheRenamer()
Dim WB As Workbook, WS As Worksheet
Dim OldName As String, NewName As String
Dim L As Integer, X As Integer

Set WB = ThisWorkbook
With WB
Set WS = .Sheets('List')
End With

L = WS.Range('A65536').End(xlUp).Row

For X = 1 To L
OldName = WS.Range('A' & X)
NewName = Right(OldName, Len(OldName) - 1 - Len(ThePath))
Name OldName As ThePath & NewName
Next X

End Sub
Sub TheFileLister()
Dim TheFileSearcher As FileSearch
Dim I As Integer
On Error Resume Next
Set TheFileSearcher = Application.FileSearch
With TheFileSearcher
.NewSearch
.Filename = '*.xls*'
.LookIn = ThePath
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
Cells(I, 1).Value = ThePath & Dir(.Item(I))
Next I
End With
Else
MsgBox 'Pas de Fichier trouvé dans ' & ThePath
End If
End With
Set TheFileSearcher = Nothing
End Sub

Désolé j'apprend aussi ici avec les boites code les smileys(je vais y arrivé) j'ai honte ;(

Temjeh

[_Thierry]

Bonsoir Temjeh, le Forum

Désolé de n'avoir répondu plus tôt, mais ce Forum est ingérable au niveau suivi de mes propres posts, je dois en faire trop !

Donc oui les ';' sont des 'parasites' venus se greffer dans la mise en forme du code, mais je te(vous) rassure, avant de publier un code je te le teste en réel toujours avant. mais c'est vrai que ce new Forum nous joue des tours.

Enfin heureux de t'avoir aidé.

Bonne soirée
@+Thierry

Message édité par: _Thierry, à: 15/03/2005 22:58