Fórum Cmo Fazer via Delphi um SaveAs no Excel? #222787

program DBFToExcel;

uses
  Messages, SysUtils, Variants, Dialogs, ComObj, dbf;

procedure GerarExcel(Consulta: TDbf; cPath: string);
var
  coluna, linha: integer;
  excel: variant;
  valor: string;
begin
  try
    excel := CreateOleObject(Excel.Application);
    excel.Workbooks.add(1);
  except
    ShowMessage(Erro. Versão do Ms-Excel Incompatível);
    Exit;
  end;

  excel.visible := false;
  Consulta.First;
  try
    for linha := 0 to Consulta.RecordCount - 1 do
      begin
        for coluna := 1 to Consulta.FieldCount do
          begin
            valor := Consulta.Fields[coluna - 1].AsString;
            excel.cells[linha + 2, coluna] := valor;
          end;
        Consulta.Next;
      end;
    for coluna := 1 to Consulta.FieldCount do
      begin
        valor := Consulta.Fields[coluna - 1].DisplayLabel;
        excel.cells[1, coluna] := valor;
      end;

    excel.columns.AutoFit;
    excel.DisplayAlerts := false;     //Evita pedir a confirmação de sobreposição
    //excel.ActiveWorkbook.SaveAs(cPath+Invoice.xls, xlnormal, , , False, false);
    excel.ActiveWorkbook.SaveAs(cPath+Invoice.xls);

    excel.Quit;
    excel := unassigned;
  except
    excel.WorkBooks.Disconnect; //desconecta sua aplicação do documento aberto no excel.
    excel.Application.Disconnect; //desconecta sua aplicação do Excel

    ShowMessage(Aconteceu um erro desconhecido durante a conversão da tabela para o Ms-Excel);
  end;
end;


var
  i: word;
  cPath: string;
  Dbf1: TDBF;
begin
  if ParamCount > 0 then
    cPath := ParamStr(1)
  else
    cPath := ExtractFileDir( ParamStr(0) );

  if Copy(cPath,Length(cPath),1)  \ then
    cPath := cPath +\;

  try
    Dbf1 := TDBF.Create(nil);
    Dbf1.TableName := Invoice.dbf;
    Dbf1.FilePathFull := cPath;
    Dbf1.Active := true;
    Dbf1.First;

    GerarExcel(dbf1, cPath);
  except
    ShowMessage(Desculpe-me, mas tive problemas p/ abrir o arquivo +Dbf1.TableName+ e gerar Invoice.xls em +cPath);
  end;

  Dbf1.Active := false;

end.