Macro Renommer fichiers?

[kikim]

Re le Forum

Dans un dossiers D:\test\ j'ai une disaine de fichiers textes dont je voudrais renommer en supprimant les caracteres "-" et "_";
Le probleme c'est que les noms de fichiers sont aleatoire et ne se ressemble pas.

Exemple: jj_mm-aaaa sera renommé jjmmaaaa
jj-mm_aaaa-vvvv sera renommé jjmmaaavvvv

Est il possible de realiser une telle macro, tout en indiquant le chemin du dossier dans la cellule A1 par exemple?!

Crdt,

 

[kjin]

Re : Macro Renommer fichiers?

Bonsoir,
Une façon de faire

Sub RenomerFich()
Dim rep As String, Nom As String, NewNom As String
rep = Range("A1") 'nom du repertoire en A1 Ex: D:\test\
Nom = Dir(rep & "*.txt") 'fichier texte, *.* si n'importe quel type
Do While Nom <> ""
    If Nom Like "*-*" Or Nom Like "*_*" Then
        NewNom = Replace(Nom, "-", "")
        NewNom = Replace(NewNom, "_", "")
        Name Nom As NewNom
    End If
Nom = Dir()
Loop
End Sub

A+
kjin

 

[kikim]

Re : Macro Renommer fichiers?

Re le forum

Merci kjin pour la réponse
malheureusement ça marche pas pour moi!
ça pourrait etre où l'erreur?

 

[kikim]

Re : Macro Renommer fichiers?

Au fait ça me donne un message d'erreur : Erreur d'execution '53' fichier introuvable;
et en jaune j'ai la ligne

Name Nom As NewNom

Et là une solutation que je vient de trouver sur un autre forum et qui marche bien!

Private Sub renommer()

Dim nom As String, lettre As String
Dim fs, dossier, fichiers, f

Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier = fs.getfolder(Range("A1"))
Set fichiers = dossier.Files

For Each f In fichiers
nom = ""
For j = 1 To Len(f.Name)
lettre = Mid(f.Name, j, 1)
If lettre <> "_" And lettre <> "-" Then
nom = nom & lettre
End If
Next j
f.Name = nom
Next f

End Sub