Macro Renommer des fichiers Résolu

Question

Bonjour, 

Je dois renommer une grande quantité de fichiers. Je possède l'ancien nom et le nouveau nom dans une feuille Excel. Il doit y avoir un moyen pour renommer ces fichiers automatiquement à partir des données Excel. 

J'ai trouvé le code VBA suivant sur un des forums car il me semble adapté à mon cas. 

Sub Ed()
    Dim Chemin As String, Fichier As String, Ligne As Integer
    Dim AncienNom As String, NouveauNom As String
    
    Chemin = "C:\Dossier1\Dossier2\DossierX\"
    
    For Ligne = 2 To 402
        AncienNom = Range("A" & Ligne).Value
        NouveauNom = Range("B" & Ligne).Value
        Fichier = Dir(Chemin & AncienNom)
        If Fichier = Empty Then
            MsgBox "le fichier " & AncienNom & " n'a pas été trouvé"
        Else
            Name Fichier As NouveauNom
        End If
    Next Ligne
End Sub

Evidemment, j'ai personnalisé ce qu'il y avait à personnaliser : chemin où se trouvent les fichiers, lignes du fichier excel à prendre en compte, colonnes où se trouvent les anciens et nouveaux noms. 

Pourtant, il ne marche pas et je ne comprends pas pourquoi. Je précise que mes fichiers ont des extensions différentes. 

merci de votre aide

Configuration: Windows XP / Internet Explorer 7.0

michel_m · Answer

Bonjour 
essaies ceci 
ancien = chemin & fichier 
nouveau = chemin & nouveaunom 
Name ancien As nouveau

j'ai écris cette macro au principe un peu différent; a toi de voir 

chemin = "D:\documents\" ' à adapter

ChDir chemin
fichier = Dir("*.*")
While fichier <> ""
    On Error GoTo erreur
    nouveaunom = Application.VLookup(fichier, Range("A1:B10"), 2, 0)
    ancien = chemin & fichier
    nouveau = chemin & nouveaunom
    Name ancien As nouveau
fich = Dir
Wend
Exit Sub

erreur:
MsgBox fichier & " inconnu dans tableau XL"
End Sub



 Michel

lermite222 · Answer

Bonjour, bonjour Michel,
excuse l'incruste.
Ton exemple est le bon mais y a 2 tites erreurs.
Sub ChangeNom()
Dim Fichier
Dim Chemin As String
Dim Ancien As String
Dim nouveaunom As String
Dim Nouveau As String

Chemin = "C:Repertoir\"
ChDir Chemin

Fichier = Dir("*.*")
While Fichier <> ""
    On Error GoTo erreur
    nouveaunom = Application.VLookup(Fichier, Range("A1:B10"), 2, 0)
    Ancien = Chemin & Fichier
    Nouveau = Chemin & nouveaunom
    Name Ancien As Nouveau
Fichier = Dir
Suivant:
Wend
Exit Sub

erreur:
    MsgBox Fichier & " inconnu dans tableau XL"
    Resume Suivant
End Sub

Ajouter Resume.
Changer Fich par Fichier
Déclarer les variables
A+

Info · Answer

Bonjour,

Autre version :


Option Explicit

Sub Ed()

    Dim Chemin As String, Fichier As Variant, Ligne As Integer
    Dim AncienNom As String, NouveauNom As String
    Dim Source As String, Destination As String
    Dim objFSO As Object
    
    Dim CheminCourt As String
    
    Chemin = "C:\Dossier1\Dossier2\DossierX\"
    CheminCourt = "C:\Dossier1\Dossier2\DossierX"
    ChDrive "C"
    ChDir CheminCourt
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    With Sheets("Feuil1")
    
        'For Ligne = 2 To 402
        For Ligne = 1 To 4
        
            AncienNom = .Range("A" & Ligne).Value
            NouveauNom = .Range("B" & Ligne).Value
            
            Fichier = Dir(Chemin & AncienNom, 6)
            
            If Fichier = Empty Then
                MsgBox "le fichier " & AncienNom & " n'a pas été trouvé"
            Else
                Source = Chemin & Fichier: Destination = Chemin & NouveauNom
                objFSO.CopyFile Source, Destination
                Kill (Chemin & AncienNom)
            End If
                
        Next Ligne
    End With
    
    Set objFSO = Nothing
    
End Sub
'


Info

cristophil · Answer

Bonjour 

J'ai voulu utilisé cette macro mais j'avoue que n'y connaissant rien j'ai un peu de mal.
J'ai dans un tableau excel une colonne ancien nom et une colonne nouveau nom
J'ai repris la macro comme suit:
Sub Ed()

    Dim Chemin As String, Fichier As Variant, Ligne As Integer
    Dim AncienNom As String, nouveaunom As String
    Dim Source As String, Destination As String
    Dim objFSO As Object
    
    Dim CheminCourt As String
    
    Chemin = "C:\Dossier1"
    CheminCourt = "C:\Dossier1"
    ChDrive "C"
    ChDir CheminCourt
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    With Sheets("Feuil1")
    
        'For Ligne = 2 To 402
        For Ligne = 2 To 62
        
            AncienNom = .Range("A" & Ligne).Value
            nouveaunom = .Range("B" & Ligne).Value
            
            Fichier = Dir(Chemin & AncienNom, 6)
            
            If Fichier = Empty Then
                MsgBox "le fichier " & AncienNom & " n'a pas été trouvé"
            Else
                Source = Chemin & Fichier: Destination = Chemin & nouveaunom
                objFSO.CopyFile Source, Destination
                Kill (Chemin & AncienNom)
            End If
                
        Next Ligne
    End With
    
    Set objFSO = Nothing
    
End Sub

La macro me retourne l'ancien nom de fichier n'a pas été trouvé
Mes fichiers sont dans c:\Dossier1
Merci de votre aide
Phil

Binzen · Answer

Bonjour,

Pour ma part, je souhaiterais dupliquer  plusieurs fois un fichier pdf dans le même dossier mais avec à chaque fois un nom différent suivant un tableau dans Excel, existe-t-il une macro un peu similaire à celle du dessus mais qui créée le fichier avant de le renommer?

Merci

Macro Renommer des fichiers

5 réponses

Discussions similaires

Newsletters