VBA to create directories based on 'date picture taken'

[Tim]

Hello Everyone,

[This is not strictly an Excel problem (sorry) but i only really use VBA in
Excel and i couldn't find a better newsgroup... and people here seem to know
everything! I posted this a while ago and got no response, so i'm just
giving it one last try before giving up]

i have a collection of unsorted photos in a directory which i want to order
into directories / sub-directories based on their date. eg, if the date a
picture (tim.jpg) is taken (i think this is from 'exif' data?) is 1st
september 2008, the directory structure would become: -

...\2008\2008_09\2008_09_01\tim.jpg

i would want to loop through each .jpg and create the relevant dirs\sub-dirs
where required. the icing on the cake would be to move the photos to the
correct sub-dir afterward!

i don't really know where to begin with it, so some pointers would be really
appreciated (or if someone knows of cheap/free software that will do this
without spending time on VBA that would be great... i've searched so far
unsuccessfully)

Thanks for any help,

Tim

 

[Peter T]

To get EXIF tags see here
http://tinyurl.com/ojdbz


For your purposes I assume you can just read the file dates, have a go with
the following

Sub testFolderDates()

FilesToFolderDates "c:\temp\pictures" ' << change

End Sub


Sub FilesToFolderDates(sFolder As String)

Dim sDates As String
Dim sDir As String
Dim sFile As String, sFileNew As String
Dim i As Long
Dim dt As Date
Dim arr
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object


If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not objFSO.FolderExists(sFolder) Then
MsgBox sFolder & " does not exist"
Exit Sub
End If

Set objFolder = objFSO.GetFolder(sFolder)

For Each objFile In objFolder.Files

sFile = objFile.Name

' optional extension check
'If InStr(2, sFile, ".jp", vbTextCompare) Then

dt = objFile.DateCreated
If objFile.DateLastModified < dt Then dt = objFile.DateLastModified

sDates = Format(dt, "yyyy\\yyyy_mm\\yyyy_mm_dd")

If Not objFSO.FolderExists(sFolder & sDates) Then

arr = Split(sDates, "\")
sDir = sFolder
For i = 0 To 2
sDir = sDir & arr(i) & "\"
If Not objFSO.FolderExists(sDir) Then
MkDir sDir
End If
Next

End If

sFileNew = sFolder & sDates & "\" & sFile
Name sFolder & "\" & sFile As sFileNew

' End If ' optional extension check
Next
End Sub

Regards,
Peter T

 

[Tim]

Many thanks Peter, I'll try it this afternoon.

To get EXIF tags see here
http://tinyurl.com/ojdbz


For your purposes I assume you can just read the file dates, have a go
with the following

Sub testFolderDates()

FilesToFolderDates "c:\temp\pictures" ' << change

End Sub


Sub FilesToFolderDates(sFolder As String)

Dim sDates As String
Dim sDir As String
Dim sFile As String, sFileNew As String
Dim i As Long
Dim dt As Date
Dim arr
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object


If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not objFSO.FolderExists(sFolder) Then
MsgBox sFolder & " does not exist"
Exit Sub
End If

Set objFolder = objFSO.GetFolder(sFolder)

For Each objFile In objFolder.Files

sFile = objFile.Name

' optional extension check
'If InStr(2, sFile, ".jp", vbTextCompare) Then

dt = objFile.DateCreated
If objFile.DateLastModified < dt Then dt = objFile.DateLastModified

sDates = Format(dt, "yyyy\\yyyy_mm\\yyyy_mm_dd")

If Not objFSO.FolderExists(sFolder & sDates) Then

arr = Split(sDates, "\")
sDir = sFolder
For i = 0 To 2
sDir = sDir & arr(i) & "\"
If Not objFSO.FolderExists(sDir) Then
MkDir sDir
End If
Next

End If

sFileNew = sFolder & sDates & "\" & sFile
Name sFolder & "\" & sFile As sFileNew

' End If ' optional extension check
Next
End Sub

Regards,
Peter T

Hello Everyone,

[This is not strictly an Excel problem (sorry) but i only really use VBA
in Excel and i couldn't find a better newsgroup... and people here seem
to know everything! I posted this a while ago and got no response, so
i'm just giving it one last try before giving up]

i have a collection of unsorted photos in a directory which i want to
order into directories / sub-directories based on their date. eg, if the
date a picture (tim.jpg) is taken (i think this is from 'exif' data?) is
1st september 2008, the directory structure would become: -

..\2008\2008_09\2008_09_01\tim.jpg

i would want to loop through each .jpg and create the relevant
dirs\sub-dirs where required. the icing on the cake would be to move the
photos to the correct sub-dir afterward!

i don't really know where to begin with it, so some pointers would be
really appreciated (or if someone knows of cheap/free software that will
do this without spending time on VBA that would be great... i've searched
so far unsuccessfully)

Thanks for any help,

Tim