Macro Renommer des fichiers
Bonjour à tous !
Je fais appel à vos dons en VBA car je suis coincé avec une manipulation qui me ferait gagner un temps précieux !
J'ai déjà fouillé tous les sujets à ce propos mais aucun ne semble fonctionner avec ma problématique :/
J'aurais besoin d'une macro qui me permette de renommer tous les fichiers d'un répertoire, puis de les déplacer dans un autre dossier en remplaçant les autres fichiers qui auront le même nom.
Tous les fichiers ont un nom initial qui peut être de l'un des 4 types suivants :
"55 - blablabla - NOM_SITE",
ou "55 - blablabla - NOMSITE",
ou "55 - blablabla - blablabla - NOM_SITE",
ou "55 - blablabla - blablabla - NOMSITE".
Je voudrais ne garder que la partie "NOM_SITE" ou "NOMSITE" pour ensuite déplacer tous les fichiers dans un autre dossier !
Quelques infos qui pourraient être utiles :
- la partie "blablabla" des 2 premiers types ont toujours le même nombre de lettres,
- même chose pour les 2 derniers types,
- mais entre le type 1/2 et 3/4, le nombre de lettres est différents
Je remercie par avance tous ceux qui essaieront de m'aider !
Bonne journée !
J.
Bonjour,
à tester,
Sub RenommeEtDéplaceFichiers()
'Nécessite d'activer la référence Microsoft Shell Controls and Automation
Dim objShell As Shell32.Shell
Dim strFileName As Shell32.FolderItem
Dim objFolder As Shell32.Folder
OldRep = "C:\Users\xxx\Documents"
NewRep = "C:\Users\xxx\Documents\cp"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(OldRep)
For Each strFileName In objFolder.Items
If strFileName.isFolder = False Then
x = Split(strFileName, "-")
Name OldRep & "\" & strFileName As NewRep & "\" & x(UBound(x))
End If
Next
End Sub