Renommage fichier PDF d'apres un listing sous Excel

Bonjour,

Voici ma problématique sur jour :

j'ai dans un dossier environ 3 000 fichier PDF

Dans un tableau Excel j'ai une correspondance entre ces fichiers et leurs vrais Noms.

petit exemple :

Nom d'un fichier PDF --> 0944bad3-de4b-4162-932b-c6dc776e9945.pdf

dans mon tableau Excel j'ai :

Colonne A : 0944bad3-de4b-4162-932b-c6dc776e9945 (nom actuelle du PDF sans l’extension)

Colonne B : 361694 (Nouveau nom à mettre)

je souhaite renommer tous mes fichiers PDF avec leur nouveau nom mais là comment faire !

J'ai pu lire différentes Macros mais je ne trouve pas ce que je cherche.

Merci à vous de votre aide

Franck

Set fso = CreateObject("Scripting.FileSystemObject")
   fso.MoveFile "d:\dummytest.txt", "d:\dummytest2.txt"
Kill "d:\dummytest.txt

Merci pour ce code, mais je ne comprend pas ou on lui indique le nom de mon fichier Excel qui contiens ma correspondance et ou je lui indique ou sont mes fichiers PDF à renommer

Merci

Franck

Bonsoir,Kisscool,

Voici le code qui devrait répondre à ta demande.

On commence à la ligne 2 de la feuille active, car je suppose que ton fichier à une entête

On teste si le fichier existe, et si oui on le renomme

Si tu veux les déplacer dans un autre répertoire en même temps, il faut d'abord qu'il soit créé

Enfin on indique si le renommage s'est effectué en colonne C

Option Explicit
Const sExt As String = ".pdf"

Sub RenommePdf()
   Dim Lig As Long
   Dim sReptOrigine As String, sFichOrigine
   Dim sReptDestination As String, sFichDestination
   ' Définition des répertoires
   sReptOrigine = "D:\Temp\"
   sReptDestination = "D:\Temp\Pdf\"
   ' Test existence des répertoires
   If Dir(sReptOrigine, vbDirectory) = "" Then
      MsgBox "Le répertoire d'origine n'existe pas !": Exit Sub
   End If
   If Dir(sReptDestination, vbDirectory) = "" Then
      MsgBox "Le répertoire de destination n'existe pas !": Exit Sub
   End If
   ' Boucle sur toutes les lignes de la plage active à partir de la seconde
   For Lig = 2 To ActiveSheet.UsedRange.Rows.Count
      If Cells(Lig, "A") <> "" Then ' Test colonne A non vide
         sFichOrigine = Cells(Lig, "A") & sExt ' définition du fichier d'origine
         sFichDestination = Cells(Lig, "B") & sExt ' Définition fichier de destination
         If Dir(sReptOrigine & sFichOrigine) <> "" Then 'Test existence fichier d'origine
         ' Déplacement et renommage du fichier
            Name (sReptOrigine & sFichOrigine) As (sReptDestination & sFichDestination)
            Cells(Lig, "C") = "Ok" ' Réussi
         Else
            Cells(Lig, "C") = "Ko" ' Echec
         End If
      End If
   Next Lig
End Sub

Bonjour est merci pour ton Code, il fonctionne bien

Si je souhaite le faire évoluer, c'est a dire, pour renommer mon fichier PDF avec plusieurs champ dans mon Excel :

Colonne A -> "Nom de mon fichier original"

Colonne B -> " Le début du Nouveaux Nom"

Colonne C -> " le deuxième insertion "

Colonne D -> " dernière insertion "

Colonne E -> " le résultat si OK ou KO"

chaque champ devra être séparer par un " - "

cela donnerais --> XXXFFZZPP.pdf comme fichier original

et en résultat :

Facture-001589658-02518.pdf

je ne sais pas si je suis bien claire mais d'avance merci

Bonne journée et d'avance merci a vous

Franck

Bonsoir Kisscool25,

Cela donne cela :

    Option Explicit
    Const sExt As String = ".pdf"

    Sub RenommePdf()
       Dim Lig As Long
       Dim sReptOrigine As String, sFichOrigine
       Dim sReptDestination As String, sFichDestination
       ' Définition des répertoires
      sReptOrigine = "D:\Temp\"
       sReptDestination = "D:\Temp\Pdf\"
       ' Test existence des répertoires
      If Dir(sReptOrigine, vbDirectory) = "" Then
          MsgBox "Le répertoire d'origine n'existe pas !": Exit Sub
       End If
       If Dir(sReptDestination, vbDirectory) = "" Then
          MsgBox "Le répertoire de destination n'existe pas !": Exit Sub
       End If
       ' Boucle sur toutes les lignes de la plage active à partir de la seconde
      For Lig = 2 To ActiveSheet.UsedRange.Rows.Count
          If Cells(Lig, "A") <> "" Then ' Test colonne A non vide
            sFichOrigine = Cells(Lig, "A") & sExt ' définition du fichier d'origine
            sFichDestination = Cells(Lig, "B") & "-" & _
                              Cells(Lig, "C") & "-" & _
                              Cells(Lig, "D") & sExt ' Définition fichier de destination
            ' Test existence du fichier d'origine et de l'inexistence du fichier de destination
            If Dir(sReptOrigine & sFichOrigine) <> "" And Dir(sReptDestination & sFichDestination) = "" Then
            ' Déplacement et renommage du fichier
               Name (sReptOrigine & sFichOrigine) As (sReptDestination & sFichDestination)
              Cells(Lig, "E") = "Ok" ' Réussi
            Else
              Cells(Lig, "E") = "Ko" ' Echec
            End If
          End If
       Next Lig
    End Sub

J'ai mis un contrôle supplémentaire pour contrôler le fichier de destination n'existe pas avant de renommer le fichier. Je n'ai pas tester, si il y a un problème redis-moi.

C'est super sympa

Merci a toi de ton aide

Franck