Renommer un fichier JPG selon donnees EXIF

Version imprimable

Bonjour,

j'ai l'ambition de me créer un petit vbscript qui me permette de renommer les photos d'un répertoire selon leur date de prise de vue.

si j'arrive bien à renommer un fichier en vbs, je ne comprends pas bien comment récupérer les données EXIF de date de prise de vue de mes photos.

pourriez-vous m'aider ? voici mon code. merci
jeremy
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Dim stRep Dim oFSO,oFl Set oFSO = CreateObject("Scripting.FileSystemObject") stRep = "C:\Users\Jerem7w\Pictures\transfert\calendrier" If oFSO.FolderExists(stRep) Then For each oFl in oFSO.GetFolder(stRep).Files oFl.Name = OFl.GetExifData(TagDateTimeOriginal) Next End If

11/01/2014, 22h22
omen999

bonjour,
ces données peuvent être lues par ce composant
pas testé...

bonjour,

je n'ai pas eu besoin d'installer le composant car la date de prise de vue est dans les données avancées.

je parviens donc à renommer mes photos selon leur date de prise de vue mais je pense que mon code est loin d'être optimal.

mon tableau pour stocker ces dates n'est pas dynamique:(
le dossier où sont stockées les photos à traiter est écrit en dur dans le script:(
je ne teste pas l'extension pour verifier qu'il s'agit bien de photos, pas de vidéos ou autres...:aie:

dois-je vider mes variables et autres tableaux à la fin ?

voilà le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Dim newName(1000) 'tableau a 1000 entrées par défaut, je n'ai rarement plus de 100 photos dans un dossier
Dim fso, FL
Dim PicDate
Dim yy, mm, dd, chaine
 
Set fso = CreateObject("Scripting.FileSystemObject")
stRep = "C:\Users\Jerem7w\Pictures\transfert\calendrier"
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("C:\Users\Jerem7w\Pictures\transfert\calendrier")
 
i=0 'initialisation d'un compteur
 
'récupération de la date de prise de vue et traitement de cette information
 
For Each strFileName in objFolder.Items
 
	PicDate = objFolder.GetDetailsOf(strFileName, 12) 'je récupère la date de prise de vue de la photo
	PicDate = (left(PicDate,13)) 'je coupe la variable en ne gardant que la date, puis ensuite j'en extrais l'année, le mois, le jour
	yy = Right(PicDate,4) 
	mm = right(left(PicDate,7),2)
	dd = left(PicDate,3)
	newName(i) = yy & "_" & mm & "_" & dd &"_" 'définition du futur nom de la photo, qui est affecté à un tableau
 
	'comme plusieurs photos peuvent avoir la même date de prise de vue, j'insère la valeur de compteur dans le nouveau nom de la photo 		
	'je m'arrange pour indicer les photos avec 3 chiffres de 000 à 999
 
		if i < 10 then 
		chaine = "00" & i
		else
		if i < 100 Then
		chaine = "0" & i
		else
		chaine = i 	
		end if
		end if	
 
	newName(i) = newName(i) & chaine
 
i = i + 1
Next
 
 
i=0 'réinitilaisation de la valeur de i
 
 
'Modification du nom du fichier
If fso.FolderExists(stRep) Then
	For each FL in  fso.GetFolder(stRep).Files
 	FichierSource = FL.path
 	extension = fso.GetExtensionName(FL)
 	FL.Name = newName(i) & "." & extension
	i = i + 1	
	Next
End If
 
msgBox i & " fichiers renommés."

Je ne comprend pas trop pourquoi tu utilises des tableaux, on peut renommer à la volée. Souvent la date de dernière modification est celle de la prise de vue.

Plutôt que de renommer, j'ai préféré copier en préfixant.

Si c'est bon pour toi, le script ci-dessous devrait te suffire, sinon, il est facile à modifier (pas sur qu'il soit propre et optimisé).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Dim oFso, sCurPath, sNewPath
Set oFso = CreateObject("Scripting.FileSystemObject")
 
sCurPath = oFso.GetAbsolutePathName(".") & "\Tests\"
sNewPath = oFso.GetAbsolutePathName(".") & "\New\"
 
If Not oFso.FolderExists(sNewPath) Then ' Répertoire de destination pour conserver les originaux
	oFso.CreateFolder(sNewPath)
End If
 
Dim f, fc, f1, sFile, sNewFile, sFileName, sFileExt
Set f = oFso.GetFolder(sCurPath)
Set fc = f.Files
 
For Each f1 in fc
 
	sFileName = oFso.GetBaseName(f1)
	sFileExt = oFso.GetExtensionName(f1)
 
	If Ucase(sFileExt) = "JPG" Then ' pour limiter aux seuls jpg
 
		sPrefixe =  Year(f1.DateLastModified) & Right("00" & Month(f1.DateLastModified),2) & Right("00" & Day(f1.DateLastModified),2)
		nRef = 0
		sRef = Right("000" & Trim(Cstr(nRef)),3)
		sNewFile = sNewPath & "\" & sPrefixe & sRef & "_" & sFileName & "." & sFileExt
		Do While oFso.FileExists(sNewFile)
			nRef = nRef + 1
			sRef = Right("000" & Trim(Cstr(nRef)),3)
			sNewFile = sNewPath & "\" & sPrefixe & sRef & "_" & sFileName & "." & sFileExt
		Loop
 
		oFso.CopyFile f1, sNewFile 
 
	End If
Next
 
Set f = Nothing
Set fc = Nothing
Set oFso = Nothing

21/01/2014, 07h29
jerem7w

Bonjour Habot,

J.utilise les tableaux pour stocker la date de prise de vue de l'image et non la date de modification que je récupère grâce à Shell.application.
Je n'ai pas trouvé s'il était possible de le faire avec FSO, d'où le tableau pour stocker l'information avant de renommer.

Jeremy

A Priori, FSO ne donne pas cette information.
Ca n'empêche pas de la prendre avec un Shell et de renommer à la volée.
J'ai modifié le script initial. Il ne devrait pas demander beaucoup de modifications pour faire ce que tu souhaites. Je l'ai testé sous Windows8, il se peut que quelques adaptations soient nécessaires.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
Dim oFso, oShell, sCurPath, sNewPath
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")
 
sCurPath = oFso.GetAbsolutePathName(".") & "\Tests\"
sNewPath = oFso.GetAbsolutePathName(".") & "\New\"
 
If Not oFso.FolderExists(sNewPath) Then ' Répertoire de destination pour conserver les originaux
	oFso.CreateFolder(sNewPath)
End If
 
Dim f, fc, f1, sFile, sNewFile, sFileName, sFileExt, oFolder, oFile, sPicDate
Set f = oFso.GetFolder(sCurPath)
Set fc = f.Files
Set oFolder = oShell.NameSpace(sCurPath)
 
For Each f1 in fc
 
	sFileName = oFso.GetBaseName(f1)
	sFileExt = oFso.GetExtensionName(f1)
 
	If Ucase(sFileExt) = "JPG" Then ' pour limiter aux seuls jpg
 
		Set oFile = oFolder.Items.Item(sFileName & "." & sFileExt)
		sDate = Left(oFolder.GetDetailsOf(oFile, 12),13)
		Set oFile = Nothing
 
		sPrefixe =  Right(sDate,4) & Right("00" & Mid(sDate,6,2),2) & Right("00" & Left(sDate,3),2)
 
		nRef = 0
		sRef = Right("000" & Trim(Cstr(nRef)),3)
		sNewFile = sNewPath & "\" & sPrefixe & sRef & "_" & sFileName & "." & sFileExt
		Do While oFso.FileExists(sNewFile)
			nRef = nRef + 1
			sRef = Right("000" & Trim(Cstr(nRef)),3)
			sNewFile = sNewPath & "\" & sPrefixe & sRef & "_" & sFileName & "." & sFileExt
		Loop
 
		oFso.CopyFile f1, sNewFile 
 
	End If
Next
 
Set f = Nothing
Set fc = Nothing
Set oFolder = Nothing
Set oShell = Nothing
Set oFso = Nothing
 
MsgBox("Ok")