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
Rechercher des sujets similaires à "macro renommer fichiers"