Archiving Digital Pictures par date taken!

Started Jan 26, 2013 | Discussions thread
TheRidgeback Regular Member • Posts: 117
Re: Very easy to do

The way i have archived mine since my trusty D100, is to put them in folders of 500 images

in order of their photo number, as that is normally in date order, to do this i created an automated VB script, that reads the name of the file, works out where the file should be, and moves the file to the folder. If the folder doesn't exist, then it creates one.
so all i have is folders like so.




ect, ect,
I then import the folders into lightroom.

the script is clever enough to work out where its run from, so you don't have to enter any file paths.
The only thing you have to do is a follows

1) it asks you the folder size, this defaults to 500.

2) it asks you if you want to use alphanumeric (Normally select NO), If you use this it will calculate a number dependent of the file name and then put it in a folder from the number generated (usefull if you have renamed your photos to a non numerical file name)

3) asks you have you renamed your files. Only if you have shot over 10000, and you need to rename them from DSC_0001.nef to DSC_10001.nef and i do have a batch file for that as well.
i.e. your camera will go from 0001 to 9999, and then create a new folder and start over at 0001
obviously the second 0001 should be 10001, so its asking you IF YOU HAVE TO RENAME YOUR FILES, HAVE YOU RENAMED YOUR FILES
4) any duplicate files appear in folders which are numbered in the millions

5) you can add variables to the script to check for all sorts of files to sort.
This script does not delete any files, it only moves them

just copy and paste the text below into a text file, and rename it to something like
Drop it into your image folder and double click and let it run.
I take no responsibility for any images lost, use at your own risk. (standard disclaimer)
I have documented it through out, so it should be easy to follow and or modify for your own use.
Try it first on a test folder with some copies of your photos, but you shouldnt have any problems.
If you do, it will show you an error message,  which should point you in the correct direction.


'Use of this script is at your own risk.
dim file_name
dim file_directory
dim alphanumeric
dim file_number
dim file_alphanumeric
dim file_destination
dim newfolder
dim folder_size
dim folder_number
dim myshell
dim ispicture

'get source directory.

Set myshell = WScript.CreateObject("WScript.Shell")
file_directory = myshell.CurrentDirectory

' error checking on
on error resume next

'call main process

' on error show helpme
if err.number<>0 then
end if

sub main()

' get folder size for standard numerical numbers default 500
'Display working directory in title so you can check ****CHANGE THE 500 BELOW TO CHANGE YOUR DEFAULT FOLDER SIZE***
folder_size= inputbox("Please Enter Folder Size",file_directory ,500)

alphanumeric = msgbox("Do you want to use Alphnumeric if available",4)

if msgbox("HAVE YOU RENUMBERED YOUR PHOTOS",4) <> 6 then
Exit sub
end if

'create file object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set fld = objFSO.getfolder(file_directory)

'run through every file
For Each f In fld.files

'dont use original result store it somewhere else


'check for image file
if checkimage(file_name) = "Y" then

'get file name
file_name = getfilename(f)
'get file number
file_number = striptext(getfilename(f))

file_alphanumeric = GetAlphanumericName(getfilename(f))

'if file is just text then use alpha number
if file_number = "" then
file_number= file_alphanumeric
end if
'if aplha is to be used then use it.
if alphanumeric =6 then
file_number= file_alphanumeric
end if

duplicate = "True"
'Calculate folder from numerical part of file
foldernumber = abs(file_number)
foldernumber = int(foldernumber/folder_size )

'calculate folder 1-500 ect
dfoldername = file_directory & "\" & cstr((foldernumber*folder_size )+1) & "-" & cstr((foldernumber*folder_size)+folder_size )
sDestination = file_directory & "\" & cstr((foldernumber*folder_size )+1) & "-" & cstr((foldernumber*folder_size)+folder_size ) & "\" & file_name

'does folder exist if it does dont create one'
if objFSO.folderexists(dfoldername) = false then
end if
'move file.

'check for duplicate first
if objFSO.FileExists(sDestination)=false then
objFSO.MoveFile f , sDestination'
duplicate = "False"


'duplicate found so change folder number and try again increase file number and try again
foldernumber = foldernumber + 1000000

end if

loop while duplicate = "True"

end if


end sub

' too add extra sort info just add to the end of ,"tif" ****They must be lower case additions as the text is converted to lower case from the file name***
function checkimage(file_name)
' get right hand 3 digits.
myextension = lcase(right(file_name,3))
select case myextension
case "jpg", "bmp", "nef", "gif", "tif"
checkimage = "Y"

case else
checkimage = "N"
end select

end function

function getfilename(findname)

myname = findname

for myloop = len(myname) to 1 step -1
if mid(findname,myloop,1)="\" then
getfilename = right(findname,len(myname)-myloop)
exit function
end if
end function

function GetAlphanumericName(oldtext)
'leavenumbers and letters
oldertext = Stripascii(oldtext)
mynumber = 0
for myloop = 1 to len(oldertext)
mytext= mid(oldertext,myloop,1)
tempnumber = tempnumber + (asc(mytext)-48)^3
'msgbox(oldertext & vbcrlf & mytext & vbcrlf & tempnumber)
end Function

function Stripascii(newtext)

asciitext = lcase(newtext)

for myloop = 32 to 47
asciitext = replace (asciitext,chr(myloop),"")
for myloop = 58 to 96
asciitext = replace (asciitext,chr(myloop),"")

for myloop = 123 to 127
asciitext = replace (asciitext,chr(myloop),"")
Stripascii = asciitext

end function

function Striptext(oldtext)

oldtext = lcase(oldtext)
for myloop = 32 to 47
oldtext = replace (oldtext,chr(myloop),"")
for myloop = 58 to 127
oldtext = replace (oldtext,chr(myloop),"")
striptext = oldtext

end function

function helpme()
msgbox("Error:" & Err.number & vbcrlf & "Disc: "& Err.description & vbcrlf & vbcrlf & "f= " & f & vbcrlf & "filename=" & file_name & VBCRLF & "filenumber=" & file_number & VBCRLF & "sDestination=" & sDestination & vbcrlf &
"dfoldername=" & dfoldername & vbcrlf )
end function

'Use of this script is at your own risk

 TheRidgeback's gear list:TheRidgeback's gear list
Nikon D3 Nikon AF-S Nikkor 24-120mm f/3.5-5.6G ED-IF VR Nikon AF Micro-Nikkor 60mm f/2.8D Nikon AF-S Nikkor 70-300mm f/4.5-5.6G VR +1 more
Keyboard shortcuts:
FForum PPrevious NNext WNext unread UUpvote SSubscribe RReply QQuote BBookmark MMy threads
Color scheme? Blue / Yellow