[VB?] Catalogatore file

[micropalla]

Ci provo

Option Explicit

app.ClearTrace

dim alb, sCF1, sCF2
set alb = app.GetCurrentAlbum
sCF1 = "Materiale" ' Primary sort key
sCF2 = "Luogo di scatto" ' Secondary sort key

dim s, k
s = "This script will sort the current album using the custom fields '"
s = s & sCF1 & "' and '" & sCF2 & "'" & chr(13)
s = s & "This album will be used: " & alb.sAlbumTitle & " (" & alb.FullName & ")" & chr(13)
s = s & "Click Yes to proceed" & chr(13)
s = s & "Click No to abort"
k = MsgBox( s, vbYesNo, "SortOnCF" )

if k = vbYes then

dim i, nbPic, pic, pic2, nDone, d1, d2
nbPic = alb.nbPicture
app.Trace "Pictures to process: " & nbPic

' Very simple sort using two loops
app.Trace "Started at: " & Time
do
nDone = 0
for i = 0 to nbPic-2
Set pic = alb.GetPicture(i)
Set pic2 = alb.GetPicture(i+1)
d1 = pic.GetCustomField(sCF1)
d2 = pic2.GetCustomField(sCF1)
'app.Trace d1 & " " & d2
if d2 < d1 then
alb.MovePicture pic2, i, False
nDone = nDone + 1
else
if (d2 = d1) and (pic2.GetCustomField(sCF2) < pic.GetCustomField(sCF2)) then
alb.MovePicture pic2, i, False
nDone = nDone + 1
end if
end if
next
app.Trace "Sorting... " & nDone & " pictures moved"
loop until nDone = 0

alb.Redraw
app.Trace "Finished at: " & Time
app.Trace "Done !"
end if