VBA - Renommer fichiers

[Jack2]

Bonjour le forum,

Je suis en train de faire une macro qui scanne les répertoires, renomme les images en mettant leurs dimensions à gauche (image.jpg --> 1200x1600test.jpg) puis les classe dans Excel par taille... Je rencontre deux problèmes. Je commence par le premier qui la fonction qui renomme

Sub FichierRenome(AncienFich As String, NouveauFich As String)
' AncienFich ex image.jpg
' NouveauFich ex 1600x1200_U2.jpg
Dim FichierInit As String
Dim Ajout As String
Dim Fso As Object
Dim i As Integer
Dim St As String

Set Fso = CreateObject("Scripting.FileSystemObject")
St = NouveauFich

On Error Resume Next
FichierInit = NouveauFich
i = 1
While Fso.FileExists(St)
    Ajout = "(" & Trim(Str(i)) & ")"
    NouveauFich = NomFichSeul(FichierInit) & Ajout & Ext
    i = i + 1
    St = NouveauFich
Wend
NouveauFich = Trim(NouveauFich)

Fso.MoveFile AncienFich, NouveauFich
Set Fso = Nothing
End Sub

Le but est de renommer un fichier existant comme dans Windows 7 : si image.jpg existe nommer le nouveau fichier image(1).jpg. Ca bug très souvent quand un des fichiers à renommer possède déjà une parenthèse, mais je n'arrive pas trouver la solution

Merci par avance

 

[journeydo]

Re : VBA - Renomer fichiers

Bonjour à toi.

Je suis novice en la matière en VBA, mais je connais tout de même quelques notions, je ne sait pas si cela pourrais t'aider mais a tu penser regarder avec cette macro. (Modifier le code en fonction de tes valeurs bien-Sûr )

Je sais que cela fait référence à une feuille, mais cela peut peut-être aider un peu non? Qu'en penses-tu ?

'''''''''''''''''''''''
Sub Recap()
Dim i As Integer

' Ton début de code


For i = 1 To Sheets.Count
If Sheets(i).Name = "Recap" Then
MsgBox "Une feuille nommée ''Recap'' existe déjà ; la renommer ou la supprimer avant de continuer"
Exit Sub
End If
Next
Sheets.Add.Name = "Recap"

' Ta fin de code

End Sub
'''''''''''''''''''''''

Ou sinon voir à partir de cet autre exemple :

'''''''''''''''''''''''

Sub en_attendant4()


Dim AncienNom As String, NouveauNom As String
AncienNom = "C:\Users\Matt\Desktop\renommage de fichiers pdf\LOAD\" & Range("A1")
NouveauNom = "C:\Users\Matt\Desktop\renommage de fichiers pdf\LOAD\" & Range("B1")
Name AncienNom As NouveauNom


End Sub

''''''''''''''''''''

Qu'en dit tu ? J'espère que je ne te mêle pas trop ou bien que je ne suis pas trop dans le champ .... Si j'ai pu aider alors tant mieux

 

[Jack2]

Re : VBA - Renomer fichiers

Bonsoir,

Merci journeydo pour ton aide. Je n'ai pas réessayé, mais la fonction Name produit le même effet (je vais revérifier).

Quant à la première méthode, je viens de faire un bout de macro qui scanne les répertoires et pour chacun d'entre eux crée une feuille avec le nom du répertoire, puis liste dans la feuille les fichiers que je recherche (musique). Cette procédure n'est pas transportable pour renommer des fichiers.

Merci a+

 

[eriiic]

Re : VBA - Renommer fichiers

Bonsoir,

j'ai voulu tester mais NomFichSeul inconnu...

eric

 

[Jack2]

Re : VBA - Renommer fichiers

Bonjour eriiiic,


Je n’avais pas fait attention. NomFichSeul[ est le résultat d'une fonction qui permet de lister les fichiers au format "1200x1600test" sans extension. Tu peux faire fonctionner la macro en rajoutant :

Dim NomFichSeul as String
NomFichSeul = "1200x1600test" 'sans extension

Puis faire varier NomFichSeul pour qu'il corresponde à un fichier existant ou mettre la procédure FichierRenome dans une boucle où AncienFich , NouveauFich et NomFichSeul pourront varier

Merci et A+

 

[eriiic]

Re : VBA - Renommer fichiers

Bonjour,

J'ai adapté comme ça pour pouvoir le faire tourner.
Pas eu de plantage, que ce soit avec un fichier nommé image.jpg ou image(ttt).jpg. Il rajoute bien (2), (3) etc

Sub test()
    FichierRenome "d:\tmp\image.jpg", "d:\tmp\image.jpg"
End Sub

Sub FichierRenome(AncienFich As String, NouveauFich As String)
' AncienFich ex image.jpg
' NouveauFich ex 1600x1200_U2.jpg
    Dim FichierInit As String
    Dim Ajout As String
    Dim Fso As Object
    Dim i As Integer
    Dim St As String
Dim NomFichSeul As String, ext As String
NomFichSeul = "d:\tmp\image" 'sans extension
ext = ".jpg"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    St = NouveauFich

    On Error Resume Next
    FichierInit = NouveauFich
    i = 1
    While Fso.FileExists(St)
        Ajout = "(" & Trim(Str(i)) & ")"
        NouveauFich = NomFichSeul & Ajout & ext 'NomFichSeul(FichierInit) & Ajout & Ext
        i = i + 1
        St = NouveauFich
    Wend
    NouveauFich = Trim(NouveauFich)

    Fso.MoveFile AncienFich, NouveauFich
    Set Fso = Nothing
End Sub

PS: écrit renomme avec 2 m stp, ça fera moins mal aux yeux.

eric

 

[Jack2]

Re : VBA - Renommer fichiers

Bonsoir,

Merci, pour ton aide. As-tu essayé avec des fichiers qui ont déjà des (2), (3) etc. Si c'est le cas, il faut que je reprenne tout pour voir d'où ça vient. Si cela t'intéresse, je peux mettre les deux procédures qu'il y a avant

PS C'est noté pour renommer

Jack

 

[eriiic]

Re : VBA - Renommer fichiers

As-tu essayé avec des fichiers qui ont déjà des (2), (3)

Oui, il passait au suivant. Tu peux tester avec ce que j'ai mis...
eric