Renommer fichier dans tous les sous repertoires

[pobrouwers]

Bonsoir le forum.

J'ai 13 fichiers (1.xls, 2.xls,.... 13.xls) stockés 7 répertoires différents.

Comment renommer tous les fichiers dans tous les répertoires par macro ?

Exemple : les fichiers 1.xls deviennent aaa.xls, 2.xls => bbb.xls

Avez-vous une idée ?

D'avance merci.

 

[pobrouwers]

Re : Renommer fichier dans tous les sous repertoires

Re,

Je viens de créer une macro mais j'ai un message d'erreur.
Erreur d'execution 58 ce fichier existe déja
Pourquoi a votre avis ?

voici le code

Sub RemameFiles()
Dim i As Integer
Dim ii As Integer
Dim Fichier As String
Dim NewName As String
Dim fs As FileSearch
 
Set fs = Application.FileSearch
 
With fs
    .NewSearch
    .LookIn = Me.TxbBrowseForFolder.Value
    .SearchSubFolders = True
    .FileType = msoFileTypeExcelWorkbooks
    .Execute msoSortByFileName, msoSortOrderAscending
 
    If .Execute() > 0 Then
      For ii = 1 To 78
        ii = ii + 1
        NewName = "\test" & ii & ".xls"
        For i = 1 To .FoundFiles.Count
        Fichier = .FoundFiles(i)
        Name Fichier As TxbBrowseForFolder & "\" & NewName
 
        Next i
      Next ii
    Else
        MsgBox "Pas de fichier(s) trouvé(s)"
    End If
End With
 
End Sub

 

[ChTi160]

Re : Renommer fichier dans tous les sous repertoires

Salut pobrouwers
Bonsoir le Forum
pas évident de tester mais il me semble (je ne sais pas si ton problème vient de la )qu'il y a un problème

NewName = "\test" & ii & ".xls"
For i = 1 To .FoundFiles.Count
Fichier = .FoundFiles(i)
Name Fichier As TxbBrowseForFolder & "\" & NewName

ce qui donne

TxbBrowseForFolder \\test" & ii & ".xls"

si tu mets un slass à NewName n'en mets pas à
Name Fichier As TxbBrowseForFolder & NewName
ou lycée de versailles
en espérant avoir fait avancer le chimilimBlic
bonne fin de Soirée

 

[ChTi160]

Re : Renommer fichier dans tous les sous repertoires

re arff
ensuite je ne comprends pas
ceci
For ii = 1 To 78 'tu fais une boucle sur ii pour des valeurs allants de 1 à 78
ii = ii + 1 'est ici tu ajoutes 1 Why alors tu boucles sur les valeurs 2 à 79
et supprime ii=ii + 1
NewName = "test" & ii & ".xls"
For i = 1 To .FoundFiles.Count
Fichier = .FoundFiles(i)
Name Fichier As TxbBrowseForFolder & "\" & NewName

Next i
Next ii

je crois si j'ai compris le raisonnement que tu boucles sur l'ensemble des fichiers
mais tu conserves la mmême valeur de ii
il faudrait essayer ceci

For i = 1 To .FoundFiles.Count 'pour chaque fichier
ii=ii+1 'initialise ii en fonction d la boucle
NewName = "test" & ii & ".xls" 'on crée le nom
Fichier = .FoundFiles(i) 'on choisi le fichier à renommer
Name Fichier As TxbBrowseForFolder & "\" & NewName
Next i

bonne fin de Soirée

​

 

[pobrouwers]

Re : Renommer fichier dans tous les sous repertoires

Re ChTi160

Merci pour ta réponse mais je viens de trouver...

voici le code ...

Sub RemameFiles()
Dim i As Integer
Dim ii As Integer
Dim Fichier As String
Dim NewName As String
Dim rep As String
Dim rep1 As Variant
Dim fs As FileSearch

Set fs = Application.FileSearch

With fs
    .NewSearch
    .LookIn = Me.TxbBrowseForFolder.Value
    .SearchSubFolders = True
    .FileType = msoFileTypeExcelWorkbooks
    .Execute msoSortByFileName, msoSortOrderAscending
    
    If .Execute() > 0 Then
On Error Resume Next
        For i = 1 To .FoundFiles.Count
        For ii = 1 To 78
        ii = ii + 1
        Fichier = .FoundFiles(i)
        rep1 = Split(Fichier, "\")
        rep = Left(Fichier, Len(Fichier) - Len(rep1(UBound(rep1))))
        Name Fichier As rep & "test" & ii & ".xls"
Next ii
        Next i
    Else
        MsgBox "Pas de fichier(s) trouvé(s)"
    End If
End With

End Sub

le 1er probleme etait le nouveau nom, ce n'était pas le bon chemin