Cette macro en VBA (Visual Basic) permet d'attribuer à une photo un nom selon l'organisation AAAAMMJJ_HHMMSS.jpg
Exemple : 20130818_101722.jpg pour une photo du 18 Août 2018 à 10H 17MN 22S
Sub ChangeNomPhotos()
Dim objFolder
Dim objFile As File
Dim TabFiles()
Dim drv As Drive
Dim strPath As String
Dim LeNomOld As String
Dim LeNomNew As String
Dim TempoTxt As String
Dim i As Integer
Dim NbFiles As Integer
Dim NameChanged As Boolean
On Error GoTo Erreur
' Specify the path of the folder
strPath = InputBox("Mettre un \ en fin de Répertoire" & Chr(10) & Chr(13) & Chr(10) & Chr(10) & "Répertoire de travail : ")
If strPath = "" Or Not Right$(strPath, 1) = "\" Then
Exit Sub
End If
'Create the object of this folder
Set objFolder = FSO.GetFolder(strPath)
NbFiles = objFolder.Files.Count
ReDim TabFiles(NbFiles - 1)
i = 0
For Each objFile In objFolder.Files
Set TabFiles(i) = objFile
i = i + 1
Next objFile
NameChanged = False
For i = 0 To NbFiles - 1
' For Each objFile In objFolder.Files
LeNomOld = TabFiles(i).Name
Cells(1, 7) = LeNomOld
' Recherche de l'extension ".jpg"
If StrComp(FSO.GetExtensionName(TabFiles(i)), "jpg") = 0 Then
' On change le Nom
LeNomNew = ConvertiNomPhoto(TabFiles(i).DateLastModified)
' On identifie le changement de nom
NameChanged = True
ElseIf StrComp(FSO.GetExtensionName(TabFiles(i)), "JPG") = 0 Then
' On change le Nom
LeNomNew = ConvertiNomPhoto(TabFiles(i).DateLastModified)
' On identifie le changement de nom
NameChanged = True
End If
' Si il y a eu changement de nom
If NameChanged = True Then
' Si les noms sont différents
If Not StrComp(LeNomOld, LeNomNew) = 0 Then
' On copy le fichier avec le nouveau nom
TabFiles(i).Copy strPath & LeNomNew
' On efface le ficher avec l'ancien nom
TabFiles(i).Delete True
NameChanged = False
Else
' Ici la Noms sont identiques
MsgBox LeNomOld, vbCritical, "Fichier existe déjà"
NameChanged = False
End If
End If
' Next objFile
Next i
Exit Sub
Erreur:
MsgBox (Err.Description)
End Sub
Function ConvertiNomPhoto(LeNom As String) As String
Dim Année As String
Dim Mois As String
Dim Jour As String
Dim Heure As String
Dim Minute As String
Dim Seconde As String
Année = Mid$(LeNom, 7, 4)
Mois = Mid$(LeNom, 4, 2)
Jour = Left$(LeNom, 2)
Heure = Mid$(LeNom, 12, 2)
Minute = Mid$(LeNom, 15, 2)
Seconde = Right$(LeNom, 2)
ConvertiNomPhoto = Année & Mois & Jour & "_" & Heure & Minute & Seconde & ".jpg"
End Function