VBA to create directories based on 'date picture taken'
 

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

VBA to create directories based on 'date picture taken'
 

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" <tmarsh-trousers-@-take off my trousers to reply-blueyonder.co.uk
wrote in message ...
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