' ------------------------------------------------------------------------------------
'				MergeAlbumsXML.vbs
' Merges two albums using XML export/import methods.
' All the selelected pictures from one album are copied to the second.
' Picture comment, keywords and custom fields are preserved.
' ------------------------------------------------------------------------------------

Option Explicit

'const CF_STRING=0
'const CF_DATE=1
'const CF_TIME=2

Function DoMerge
dim albSrc, albDst
set albSrc = app.GetAlbum(1)
set albDst = app.GetAlbum(0)

dim s, k
s = "This script will append the selected pictures from one album to another." & chr(13) & chr(13)
s = s & "First album: " & albSrc.sAlbumTitle & " (" & albSrc.FullName & ")" & chr(13)
s = s & "Second album:" & albDst.sAlbumTitle &  " (" & albDst.FullName & ")" & chr(13) & chr(13)
s = s & "Click Yes to copy 1 --> 2" & chr(13)
s = s & "Click No  to copy 2 --> 1" & chr(13) & chr(13)
s = s & "Click Cancel to abort"
k = MsgBox( s, vbYesNoCancel, "MyAlbum Merger" )

if k = vbYes or k = vbNo  then

  if k = vbNo then
    dim a
    set a = albSrc
    set albSrc = albDst
    set albDst = a
  end if

  dim i, j, kw, kw2

  ' Process each picture
  Dim nbPic
  nbPic = albSrc.nbPicture
  app.Trace "Pictures to copy to second album: " & nbPic

  dim pic, pic2, filename
  for i = 0 to nbPic-1
    Set pic = albSrc.GetPicture(i)
    if pic.bSelected then	' Process only the selected pictures

      s = pic.xmlEncode( 0, True )
      Set pic2 = albDst.xmlDecodePicture( s, "" )
    end if
  next

  albDst.Redraw
  app.Trace "Done !"

end if
End Function


' Main program
app.ClearTrace

dim nb
nb = app.nbAlbum
if nb < 2 then
  MsgBox "Two albums should be open for the merge operation", 0, "MyAlbum Merger"
else
  DoMerge
end if