Renommer dans le bon format

Bonjour à tous, je suis débutant en VBA un très très gros débutant.

J'ai actuellement un code VBA qui me permet de renommer mes fichiers (peut importe le fichier), sauf que, étant novice, je n'arrive pas à créer un code VBA qui me permette de renommer le fichier et de le laisser dans son extension avant "renommage" en effet je dois choisir l'extension avant ce qui est problématique lorsque je reçoit plus de 200 images d'un coup dans 3 formats différents .

Edit: j'aimerai que sa lise le format exemple: .jpg. Et que lors du rename il reste en .jpg mais un .ai que sa le conserve en .ai après le rename

Merci de votre aide

et voici le code VBA que j'ai fais ainsi qu'un capture d'écran de la page excel.

Sub LesBonsFichiers()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim I As Long
'Chemin du dossier ‡ analyser (‡ adapter au besoin)
Chemin = "C:\Renommer\"

'DÈfinition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
' Boucle sur les fichiers
I = 2
For Each Fichier In Dossier.Files
maLigne = NumLig(Fichier.Name)
If maLigne <> 0 Then
    Dim SourceFichier, DestinationFichier
    SourceFichier = Chemin & Fichier.Name
    NewNom = Cells(maLigne, 2).Value
    DestinationFichier = Chemin & "\OK\" & NewNom & ".jpg"

    FileCopy SourceFichier, DestinationFichier
    Cells(maLigne, 3).Value = "OK"
End If

Next
MsgBox ("Fini!")
End Sub
Public Function NumLig(Texte) As Integer
On Error GoTo ErrNumLig
NumLig = Columns(1).Find(Texte, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False).Row
Exit Function
ErrNumLig:
    NumLig = 0
End Function

Bonjour,

Une proposition à tester :

Sub LesBonsFichiers()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim I As Long
Dim longExt As Integer  ''' ajout
Dim Ext2 As String      ''' ajout
Dim Posi As Integer      ''' ajout
'Chemin du dossier ‡ analyser (‡ adapter au besoin)
Chemin = "C:\Renommer\"

'DÈfinition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
' Boucle sur les fichiers
I = 2
For Each Fichier In Dossier.Files
maLigne = NumLig(Fichier.Name)
If maLigne <> 0 Then
    Dim SourceFichier, DestinationFichier
    SourceFichier = Chemin & Fichier.Name
    Posi = InStrRev(SourceFichier, ".")    ''' ajout
    longExt = Len(SourceFichier) - Posi     ''' ajout
    Ext2 = Right(SourceFichier, longExt + 1) ''' ajout
    NewNom = Cells(maLigne, 2).Value
    DestinationFichier = Chemin & "\OK\" & NewNom & Ext2  ''' mofif de la fin
    FileCopy SourceFichier, DestinationFichier
    Cells(maLigne, 3).Value = "OK"
End If

Next
MsgBox ("Fini!")
End Sub

Gelinotte

Bonjour,

Reprise dans le post précédent.

Gelinotte

Bonjour,

Pour Posi = InStr(1, SourceFichier, ".") j'utiliserais plutôt :

Posi = InStrRev(SourceFichier, ".")

recherche du "." en partant de la fin. Un nom de fichier peut contenir plusieurs "."

eric

Bonjour,

Merci Eriiic, c'est ce que je cherchais "à partir de la droite".

Je modifie le code sous peu.

Gelinotte

Waouh, merci beaucoup aux réponses, je reviens vers vous dès que je peux tester (Jeudi)

Je vous promet de vous apporter une réponse. Merci à vous !!!!!

A bientôt !

Bonjour à tous merci pour votre aide vous êtes géniaux la maccro marche parfaitement ! merci beaucoup !