' ========================================================================================================
'
' Script for moving/cataloguing image files based on the date the picture was taken
' Are Westby 062106
'
' Changelog:
'
' 1.0 Sorts, creates folders and moves files to relevant folders based on DatePictureTaken EXIF header (25)
'
' ToDo:
'
' * Integrate recursive folder search (currently, all images must reside in one folder (defined in oFolder and Folder))
' * Create inputbox allowing user to specify EXIF (or other) parameters as base for sorting
' * Add error checking and conditions for files without headers, and alternate sorting
' * Clean up code ;)
' * Switch to less ugly date hack
'
' ========================================================================================================
' Start script
' 
' Variables and constants

Set Fso = CreateObject("Scripting.Filesystemobject")
Set Folder = Fso.GetFolder("C:\Documents and Settings\Maren\Mine dokumenter\Bilder\bygninger")
Set Shell = CreateObject("Shell.Application")
Set oFolder = Shell.Namespace("C:\Documents and Settings\Maren\Mine dokumenter\Bilder\bygninger")
Const adVarChar = 200

' Create and open recordset, and populate arrays

Set Rs = CreateObject("ADOR.Recordset")
Rs.Fields.Append "filename",adVarChar,255
Rs.Fields.Append "createdate",adVarChar,255

Rs.Open

For each f in oFolder.Items
FDate = oFolder.GetDetailsOf(f,25)
  Rs.AddNew array("filename","createdate"), _
            array(f.name, fdate)
  Rs.Update
Next

' Start loop

If not (Rs.BOF and Rs.EOF) Then
  Rs.Sort = "createdate desc"
  Rs.Movefirst
  Do until rs.eof

' Create monthly folders, and trim foldernames to "yyyy.mm"

FCreateDate = Rs.Fields("createdate")
FileName = Folder & "\" & Rs.Fields("filename")
FolderDate = Folder & "\" & Mid(FCreateDate,7,4) & "." & Mid(FCreateDate,4,2) & "\"

If Fso.FolderExists(FolderDate)=false then
Fso.CreateFolder(FolderDate)
End If

' Move each file to related folder

Fso.Movefile Filename, FolderDate

  Rs.Movenext
  Loop
End If

' Close

Set Rs = nothing
Set Folder = nothing
Set Fso = nothing
Set Shell = nothing
Set oFolder = nothing

' ========================================================================================================