solved: there happens to be a script ...

Post Reply
Ralf
Posts: 109
Joined: 19 Jan 19 14:37

solved: there happens to be a script ...

Post by Ralf » 11 Sep 21 15:48

Hi there,
there happens to be a script in the repository (didn't find anything) with which I can implement the following

- Create subdirectory (query name) and
- can then move the marked photos there?
Last edited by Ralf on 12 Sep 21 11:37, edited 1 time in total.
Ralf
---------------------------------------------------------------------------------
Hobby photographer with many pictures (> 100000) of the family over generations.
(Excuse my english)

Hert
Posts: 6993
Joined: 13 Sep 03 7:24

Re: there happens to be a script ...

Post by Hert » 12 Sep 21 7:53

Use the script below at your own risk. It's a script that I personally use to move my iPhone pictures (which I copy to a temporary folder first) to my archive.

Make sure to configure the 3 constants at the top.

Code: Select all

const
  cPhotosRootFolder = 'C:\My Photos';
  cSubFoldersMask   = '%yyyy\%mm\%yyyy-%mm-%dd';
  cFileNameMask     = '%yy%mm%dd-%xmp:tiff:Model-%FileName.%FileExtension';

  procedure MoveItem(AImage: TImageItem; ACatItem: TCatalogItem);
  var
    ATargetFileName: WideString;
  begin
    ATargetFileName := WideIncludeTrailingBackslash(ACatItem.ParseMacros(cPhotosRootFolder, nil, nil));
    if cSubFoldersMask <> '' then
    begin
      ATargetFileName := ATargetFileName + WideIncludeTrailingBackslash(ACatItem.ParseMacros(cSubFoldersMask, nil, nil));
    end;
    ATargetFileName := ATargetFileName + ACatItem.ParseMacros(cFileNameMask, nil, nil);

    //if Ask2(AImage.FileName, ATargetFileName) then
    begin
      if WideForceDirectories(WideExtractFilePath(ATargetFileName)) then
      begin
        if AImage.MoveFile(ATargetFileName, False, True, True) then
        begin
          // now that the file is moved, update the catalog
          ACatItem.FileName := ATargetFileName;
          ACatItem.UpdateFileInfo;
          PublicCatalog.StoreItemToDataBase(ACatItem, False);
        end;
      end;
    end;
  end;

  procedure HandleImage(AImage: TImageItem);
  var
    ACatItem: TCatalogItem;
  begin
    ACatItem := TCatalogItem.Create(nil);
    try
      if PublicCatalog.FindImageCombined(AImage, ACatItem, False, vptNone) then
        MoveItem(AImage, ACatItem);
    finally
      ACatItem.Free;
    end;
  end;

var
  i: Integer;
  APro: TxomProgress;
begin
  APro := TxomProgress.Create(nil);
  try
    APro.Caption := 'Move files to folder';
    APro.CanCancel := True;
    APro.Max := Selected.Count;
    APro.Pos := 0;

    for i := 0 to Selected.Count - 1 do
    begin
      APro.Pos := i + 1;
      APro.ProgressText := Selected.Items[i].FileName;

      HandleImage(Selected.Items[i]);

      if APro.Cancel then
        break;
    end;
  finally
    APro.Free;
  end;
end;
This is a user-to-user forum. If you need product support then please send a message

Ralf
Posts: 109
Joined: 19 Jan 19 14:37

Re: there happens to be a script ...

Post by Ralf » 12 Sep 21 11:37

great, a big thank you that works great
Ralf
---------------------------------------------------------------------------------
Hobby photographer with many pictures (> 100000) of the family over generations.
(Excuse my english)

Post Reply