Aamaakdatum foto ophalen

[keb]

Ik heb een VB-routine waarin ik momenteel de datums van een reeks foto's in Excel plaats.
De commando-regel luidt:
Cells(row, 4) = fs.GetFile(mypath & myfile).DateCreated 'DateCreated

Ik wil echter de oorspronkelijke opnamedatum van de foto achterhalen.
De volgende regel werkt niet.
Cells(row, 4) = fs.GetFile(mypath & myfile).Modified 'Modified

Vraag:
Kan ik de oorspronkelijke opnamedatum van fotobestanden automatisch in een Excel-lijst plaatsen, zo ja hoe?

Zie bijlage.

 

[E v R]

Kijk eens hier: (even stuk naar beneden scrollen)
http://www.snb-vba.eu/VBA_Bestanden_en.html#L_2.23

 

[Tardis]

De link waar E v R mee komt gaat je probleem niet oplossen.
Kijk hier eens (Engelstalig), reactie van AV-Guy:

https://it.toolbox.com/question/metadata-extract-072310

Code leest een aantal eigenschappen uit waaronder de Date Taken (de datum waarop een foto is genomen met een camera).

Voor de goede orde, dit is de code die AV-Guy geschreven heeft (zelf even aanpassen naar jouw situatie):

Private Sub Show_Image_Details()

Dim i As Integer
Dim fPath As Variant
Dim strDims As String
Dim objShell As Object
Dim objFolder As Object
Dim strFileName As Object
Dim arrValues(7) As String
Dim arrHeaders(39) As String

fPath = "C:\Files"

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

'Gather all available details for demo purpose
For i = 0 To 39
arrHeaders(i) = i & " = " & objFolder.GetDetailsOf(objFolder.Items, i)
Next

'Manually set these as they are empty
arrHeaders(27) = "27 = Image Width"
arrHeaders(28) = "28 = Image Height"

'Display all available items for demo purpose
MsgBox Join(arrHeaders, vbNewLine), vbInformation, "Available Items List"

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

'Look only for image files
If InStr(objFolder.GetDetailsOf(strFileName, 2), "Image") Then

'Gather image related details
arrValues(0) = "File Name = " & objFolder.GetDetailsOf(strFileName, 0)
arrValues(1) = "File Size = " & objFolder.GetDetailsOf(strFileName, 1)
arrValues(2) = "File Type = " & objFolder.GetDetailsOf(strFileName, 2)
arrValues(3) = "Camera Model = " & objFolder.GetDetailsOf(strFileName, 24)
arrValues(4) = "Date Taken = " & objFolder.GetDetailsOf(strFileName, 25)
arrValues(5) = "Dimensions = " & objFolder.GetDetailsOf(strFileName, 26)
arrValues(6) = "Image Width = " & objFolder.GetDetailsOf(strFileName, 27)
arrValues(7) = "Image Height = " & objFolder.GetDetailsOf(strFileName, 28)

'Display image details for demo purpose
MsgBox Join(arrValues, vbNewLine), vbInformation, "Image Properties"

End If

Next

End Sub

 

[keb]

Tardis,

Enorm bedankt. Dit is precies wat ik zocht!
Hiermee kan ik mijn fotobeheer-programma aanpassen.

Keb

 

[keb]

Omdat ik een uniforme datumnotatie nastreef gebruikte ik

Cells(row, 4) = CDate(objFolder.GetDetailsOf(strFileName, 12)) 'Date taken​

maar dat geeft aan "Typen komen niet met elkaar overeen".

Onderstaande regels werken wel:

Cells(row, 4) = objFolder.GetDetailsOf(strFileName, 12) 'Date taken
Cells(row, 10) = CDate(objFolder.GetDetailsOf(strFileName, 3)) 'Date modified
Cells(row, 11) = CDate(objFolder.GetDetailsOf(strFileName, 4)) 'Date created​

Vraag:
Waarom levert objFolder.GetDetailsOf(strFileName, 12) een ander formaat gegeven op?