Need help to change this code I found to get data information from a folder

[dee101]

I found this macro to get some information from files in a folder, the folder I have has pictures in it and I want to get the date the picturs were taken, this is putting in some kind of date but it is not when they were taken.

How would I do that, I am using Excel 2003 if that helps

Thanks

Sub listfiles()

Dim r As Integer, F As String, Directory As String

Directory = Application.DefaultFilePath _

& "\My Pictures\Old Building And Things\"

r = 1

Cells(r, 1) = "FileName"

Cells(r, 2) = "Size"

Cells(r, 3) = "Date Time"

Range("A1:c1").Font.Bold = True

'Get Directory

F = Dir(Directory) ', 7)

Do While F <> ""

r = r + 1

Cells(r, 1) = F

Cells(r, 2) = FileLen(Directory & F)

Cells(r, 3) = FileDateTime(Directory & F)

'Get next File

F = Dir()

Loop

End Sub

 

[dee101]

It is faster but still gives the wrong date

 

[mrshl9898]

There's another method here using the Microsoft Windows Image Acquisition Library. (worked on the file you uploaded )

VBA to get name, date and GPS data from pictures in a folder

I have looked and can't fine code to do this, I have a folder with pictures in it and I would like to put the names of each picture in the folder in column A, date taken in column B and if the pictures have GPS data for them put the latitude in column C and the longitude in column D, can this...

www.mrexcel.com

Sub listfiles()

Dim r As Integer, F As String, Directory As String

Set ImgFile = New WIA.ImageFile

Directory = "C:\Users\andrew.marshall\Desktop\"

r = 1

Cells(r, 1) = "FileName"

Cells(r, 2) = "Size"

Cells(r, 3) = "Date Time"

Cells(r, 3) = "Created"

Range("A1:c1").Font.Bold = True

'Get Directory

F = Dir(Directory)

Do While F <> ""

r = r + 1

Cells(r, 1) = F

Cells(r, 2) = FileLen(Directory & F)

Cells(r, 3) = FileDateTime(Directory & F)

ImgFile.LoadFile (Directory & F)

Cells(r, 4) = ImgFile.Properties("ExifDTOrig")

'Get next File

F = Dir()

Loop

End Sub

 

[mrshl9898]

*Fixed the headings

Sub listfiles()

Dim r As Integer, F As String, Directory As String

Set ImgFile = New WIA.ImageFile

Directory = Application.DefaultFilePath _

& "\My Pictures\Old Building And Things\"

r = 1

Cells(r, 1) = "FileName"

Cells(r, 2) = "Size"

Cells(r, 3) = "Date Time"

Cells(r, 4) = "Created"

Range("A1:D1").Font.Bold = True

'Get Directory

F = Dir(Directory)

Do While F <> ""

r = r + 1

Cells(r, 1) = F

Cells(r, 2) = FileLen(Directory & F)

Cells(r, 3) = FileDateTime(Directory & F)

ImgFile.LoadFile (Directory & F)

Cells(r, 4) = ImgFile.Properties("ExifDTOrig")

'Get next File

F = Dir()

Loop

End Sub

 

[dee101]

I still get the last modified date?

 

[mrshl9898]

Wow... Even for the attached one you sent?

 

[dee101]

Yes, don't know what is going on but thanks for putting in so much time on this

 

[mrshl9898]

I'm pulling in this when I save the attachment.

FileName	Size	Date Time	Created
!1.JPG	225455​	22/02/21 09:05​	2017:11:26 13:34:56

There was another Property that had the same 2017 date (ExifDTDigitized), so try the below.

Sub listfiles()

Dim r As Integer, F As String, Directory As String

Set ImgFile = New WIA.ImageFile

Directory = Application.DefaultFilePath _

& "\My Pictures\Old Building And Things\"

r = 1

Cells(r, 1) = "FileName"

Cells(r, 2) = "Size"

Cells(r, 3) = "Date Time"

Cells(r, 4) = "Created"

Range("A1:D1").Font.Bold = True

'Get Directory

F = Dir(Directory)

Do While F <> ""

r = r + 1

Cells(r, 1) = F

Cells(r, 2) = FileLen(Directory & F)

Cells(r, 3) = FileDateTime(Directory & F)

ImgFile.LoadFile (Directory & F)

Cells(r, 4) = ImgFile.Properties("ExifDTDigitized")

'Get next File

F = Dir()

Loop

End Sub

If that fails hopefully someone can step in and help here, i've exhausted the methods I could find.

 

[dee101]

Sorry it took so long to get back to you, been out of town, but I still get the last modified date