[VB?] Catalogatore file

[micropalla]

Ciao a tutti.
Scusate questo post, in realtà non sviluppo in Visual Basic quindi vi scrivo solo se potete darmi una mano a risolvere un problema con questo linguaggio che ho da parecchio tempo pur non utilizzandolo praticamente mai.

In pratica utilizzo un catalogatore di immagini chiamato MyAlbumPro che permette di catalogare le foto in base a campi personalizzati.
Ora nel programma è insito uno script visual basic che permette di fare il sort delle immagini basandosi su questi due campi, ma io vorrei estenderli a 4 visto che 2 sono davvero troppo pochi per le mie esigenze.

Il titolare del programma non da segni di vita, perciò mi rivolgo a voi per i quali probabilmente mettere le mani sarà uno scherzo...

Ecco il codice di quello che fa il sort su due campi personalizzati (nel caso MAteriale e Luogo di scatto); come potrei procedere per aggiungerne altri due ??

Grazie per le eventuali risposte !!

__________________________________________________ __
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
__________________________________________________ _____

[alka]

A quale versione di Visual Basic fai riferimento?

[micropalla]

Ciao !
Come ti dicevo non ne ho la benchè minima idea, VB non lo conosco affatto...

[alka]

Originariamente inviato da micropalla
Come ti dicevo non ne ho la benchè minima idea, VB non lo conosco affatto...

Scusa, ma se chiedi di apportare modifiche al codice, significa che prima o poi lo compilerai in qualche modo creando un eseguibile aggiornato.

Se non sai tu con quale programma compilare il codice in tuo possesso, chi può saperlo?

[wallrider]

Originariamente inviato da alka
...
Se non sai tu con quale programma compilare il codice in tuo possesso, chi può saperlo?

E se non dovesse compilarlo? Magari è un vbs ...

[micropalla]

Guarda, so che il programma esegue direttamente uno script visual basic, quindi sarebbe solo da modificare questo dicendogli in pratica che non esistono due campi personalizzati ma 4, e che quindi deve iniziare ad ordinare le foto come fa ora ma non si deve fermare al secondo campo ma se il primo è uguale e il secondo pure, deve andare al terzo; li se è uguale andare al 4 altrimenti fermarsi...

In pratica il loppo che fa ora come si vede dal codice deve farlo con 4 elementi anzichè due...

Non so se sono riuscito a spiegarmi...

[micropalla]

Infatti è un vbs !!
Che dovevo dirvelo prima ???

[wallrider]

potresti ripostare il codice usando il bottone CODE?

[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

[wallrider]

Originariamente inviato da micropalla
Infatti è un vbs !!
Che dovevo dirvelo prima ???

Si! :rollo: Probabilmente ti diranno che 6 nel forum sbagliato