Anulowanie nadpisywania pliku, wybranego przez SaveDialog

0

Witam,
jak przechwycić zdarzenie ANULUJ Gdy program pyta czy nadpisać plik?
Ponieważ u mnie wyskakuje po tym błąd
Metoda SaveAs z klasy Workbook nie powiodła się.

1
if OpenDialog1.Execute then
begin
  ...
end;
0
procedure TPrzeglad_czynnosci_podczas_pracy.EksportClick(Sender: TObject);
begin
if DBGrid1.Columns[0].Field.Value=NULL then
MessageBox(Handle,'Brak danych!', 'U W A G A!', MB_OK + MB_ICONSTOP)
else
begin
saveDialog1 := TSaveDialog.Create(self);

saveDialog1.Title := 'Zapis danych';

 SaveDialog1.Filter := 'Excel File|*.xls|Excel File |*.xlsx|';
     if SaveDialog1.Execute then
     begin
Pasek_laduj.Show;
        SaveToExcelFile(SaveDialog1.FileName);
      MessageBox(Handle,'Zapis zakończony powodzeniem', 'U W A G A!', MB_OK + MB_ICONINFORMATION);
     Pasek_laduj.Close;
     end
     else
     begin
     MessageBox(Handle,'Zapis zakończony niepowodzeniem', 'U W A G A!', MB_OK + MB_ICONSTOP);
     end;
     saveDialog1.Free;
end;
 

Niezbyt bo program najpierw pyta o lokalizacje pliku wybieram plik, który istnieje.
Następnie przechodzi mi po danych i po tym wszystkich pyta czy nadpisać.
Jak dam tak to działa, jak anuluj wyskakuje błąd.

0

Nie jestem pewien czy o to Ci chodzi ale poniżej w pełni działający kod, który zapisuje blob z bazy do pliku

procedure TfmRejestrWydr.bF3Click(Sender: TObject);
var
  MemStm: TMemoryStream;
  Stm: TStream;
begin
  inherited;
  if not bF3.Enabled or not bF3.Visible then
    Exit;

  try
    dlgSave.Filename := qRWD.FieldByName('FRNAME').AsString;
    if qRWD.FieldByName('FRPL').IsNull then
    begin
      MessageDlg('Brak pliku szablonu.', mtWarning, [mbOK], 0);
      Exit;
    end
    else
    if dlgSave.Execute then
      if dlgSave.FileName <> '' then
      begin
        MemStm := TMemoryStream.Create;
        Stm := TStream.Create;
        Stm := qRWD.CreateBlobStream(qRWD.FieldByName('FRPL'),bmRead);
        Stm.Position := 0;
        MemStm.CopyFrom(Stm,Stm.Size);
        MemStm.SaveToFile(dlgSave.FileName);
        if FileExists(dlgSave.FileName) then 
        begin
          ChangeFileExt(dlgSave.FileName,'.txt');
          MessageDlg('Szablon zapisany w :'+ ExtractFilePath(dlgSave.FileName), mtInformation, [mbOK], 0);
        end;
      end;
  finally
    MemStm.Free;
    Stm.Free;
  end;
end;
0

@Kazik1 - poniżej umieszczam Twój kod, tyle że przerobiony i sformatowany; Pozwala on na poprawne wykrycie anulowania okna dialogowego i odpowiednie zareagowanie:

procedure TPrzeglad_czynnosci_podczas_pracy.EksportClick(Sender: TObject);
begin
  if DBGrid1.Columns[0].Field.Value = NULL then
    MessageBox(Handle,'Brak danych!', 'U W A G A!', MB_OK + MB_ICONSTOP)
  else
  with TSaveDialog.Create(Self) do
  try
    Title := 'Zapis danych';
    Filter := 'Excel File|*.xls|Excel File |*.xlsx|';

    if Execute() then
    begin
      Pasek_laduj.Show();
      SaveToExcelFile(FileName);
      MessageBox(Handle,'Zapis zakończony powodzeniem', 'U W A G A!', MB_OK + MB_ICONINFORMATION);
      Pasek_laduj.Close();
    end
    else
      MessageBox(Handle, 'Zapis anulowany', 'U W A G A!', MB_OK + MB_ICONSTOP);
  finally
    Free();
  end;
end;

Jeżeli medota Execute zwróci True, czyli plik zostanie wybrany z dysku lub zostanie podana poprawna jego nazwa - wykonany zostanie zapis; Jeżeli okno zostanie zamknięte krzyżykiem lub przyciskiem Anuluj - pokaże się jedynie komunikat o anulowaniu zapisu i nic więcej; Jeżeli nadal dzieją się dziwne rzeczy, to na pewno nie w tej metodzie;

Tak przy okazji - wyświetlanie komunikatu o anulowaniu zapisu jest raczej zbędne.

0

Dalej pokazuje błąd.

Niestety nie wiem dlaczego tak się dzieje..
Mogłbym dodać:

 Excel.DisplayAlerts := False;

Ale chciałbym aby przed zapisem spytało czy nadpisać.

Mógłby ktoś podpowiedzieć dlaczego taki błąd?

 
procedure TPrzeglad_czynnosci_podczas_pracy.SaveToExcelFile(const AFileName: TFileName);
const
  Worksheet = -4167;
var
  Row, Col: Integer;
  Excel, Sheet, Data: OLEVariant;
  I, J, DataCols, DataRows: Integer;
begin
  DataCols := ClientDataset1.FieldCount;
  DataRows := ClientDataset1.RecordCount + 1; //1 for the title

  Data := VarArrayCreate([1, DataRows, 1, DataCols], varVariant);

  for I := 0 to DataCols - 1 do
    Data[1, I+1] := ClientDataset1.Fields[I].FieldName;

  J := 1;
  ClientDataset1.First;
  while (not ClientDataset1.Eof) and (J < DataRows) do
  begin
    for I := 0 to DataCols - 1 do
      Data[J + 1, I + 1] := ClientDataset1.Fields[I].Value;
    Inc(J);
    ClientDataset1.Next;
  end;

  Excel := CreateOleObject('Excel.Application');
  try
    Excel.Visible := False;

    Excel.Workbooks.Add(Worksheet);                                 
    Sheet := Excel.Workbooks[1].WorkSheets[1];
    Sheet.Name := 'Sheet1';
   
    Sheet.Range[RefToCell(1, 1), RefToCell(DataRows, DataCols)].Value := Data;
   
    try
      Excel.Workbooks[1].SaveAs(AFileName);
    except
      on E: Exception do
        raise Exception.Create('Data transfer error: ' + E.Message);
    end;
  finally
    if not VarIsEmpty(Excel) then
    begin
      Excel.DisplayAlerts := False;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
1

No to po co wywołujesz ponownie wyjątek?

    try
      Excel.Workbooks[1].SaveAs(AFileName);
    except
      on E: Exception do
        raise Exception.Create('Data transfer error: ' + E.Message);
    end;

Zmień na:

    try
      Excel.Workbooks[1].SaveAs(AFileName);
    except
    //tu nic nie trzeba robić
    end;

Teraz niby dalej będzie pokazywało wyjątek ale tylko podczas debugowania w środowisku Delphi.

0

Jeśli skorzystasz z drugiego przykładu jaki podał poprzednik, to ewentualnie możesz pomiędzy Except a End wstawić samo Raise, dzięki czemu wyjątek zostanie puszczony do procedury nadrzędnej; Ale to tylko w przypadku, gdy ten wyjątek potrzebujesz puścić dalej i w jakiejś procedurze nadrzędnej go obsłużyć;

W innych przypadkach nie musisz stosować Raise, a nawet całego bloku Try Except, jeżeli w ogóle nie będziesz obsługiwać wyjątku; Wtedy wyjątek poleci, przerwie daną procedurę/metodę i tyle; Z bloków zabezpieczających korzystaj tylko wtedy, gdy to ma sens, a nie wszędzie gdzie popadnie.

1 użytkowników online, w tym zalogowanych: 0, gości: 1