' ------------------------------------------------------------------------------------ ' Sort the keywords in the current album ' ' Written by Chris A Harris August 2000 ' Adapted from SortOnCFDate.vbs '------------------------------------------------------------------------------------ Option Explicit app.ClearTrace dim alb set alb = app.GetCurrentAlbum dim skw, s, k s = "This script will sort the keywords in the current album '" & 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, "SortOnKeyWord" ) if k = vbYes then dim i, nbKw, kw, kw1, kw2, bDone nbKw = alb.nbKeyword app.Trace "Keywords to process: " & nbKw ' Very simple sort using two loops do bDone = True for i = 0 to nbKw-2 Set kw1 = alb.GetKeyword(i) Set kw2 = alb.GetKeyword(i+1) if kw2.sName < kw1.sName then kw = kw1.sName ' app.trace kw & " " & kw1.sName &" " & kw2.sName kw1.sName = kw2.sName kw2.sName = kw bDone = False ' app.trace kw & " " & kw1.sName &" " & kw2.sName end if next loop until bDone=True alb.Redraw app.Trace "Done !" end if