Bit of a mash from other macros but works as a quick job


Private Sub Show_Image_Date()

Dim fPath As Variant
Dim objShell As Object
Dim objFolder As Object
Dim strFileName As Object
Dim NewName As String

fPath = "C:\Documents and Settings\uksiwm\Desktop\New Folder (3)\DCIM\XPRIA"

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(fPath)

'Loop through all Items (files) in folder "C:\Files"
For Each strFileName In objFolder.Items

If InStr(strFileName, ".jpg") 0 Then

'Ignore if EXIF missing
If Len(objFolder.GetDetailsOf(strFileName, 25)) 0 Then

'MsgBox "Date Taken = " & objFolder.GetDetailsOf(strFileName, 25), , strFileName

NewName = Year(objFolder.GetDetailsOf(strFileName, 25)) & Right("0" & Month(objFolder.GetDetailsOf(strFileName, 25)), 2) & Right("0" & Day(objFolder..GetDetailsOf(strFileName, 25)), 2) & "_" & Right("0" & Hour(objFolder.GetDetailsOf(strFileName, 25)), 2) & Right("0" & Minute(objFolder.GetDetailsOf(strFileName, 25)), 2) & Right("0" & Second(objFolder.GetDetailsOf(strFileName, 25)), 2)
NewName = NewName
NewName = fPath & "\" & NewName & "_" & Right(strFileName, 8)

Name fPath & "\" & strFileName As NewName

End If

End If

Next

End Sub