delphi能不能实现批量将dbf文件转换成xls文件

Question

delphi能不能实现批量将dbf文件转换成xls文件？
望指教，谢谢

Answer 1

有办法，ADO连接xls后． jet sql有一个in的关键字，除像sql中的in外,还有其它用法．
我一时说不清，你google一下吧．

Answer 2

unit SwDBToFile;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DB, comctrls, DBTables,SwCountQty;type
  ESwDBToFileError=class(Exception);
  TSaveBuffer=procedure(Rows, Count: integer; Value: Variant) of object;
  TSaveTitle=procedure of object;
  TSetBuffer=procedure(Rows: integer; var Value: Variant) of object;  TSwDBToFile = class(TComponent)
  private
    { Private declarations }
    FSaveDialog: TSaveDialog;
    FDataSource: TDataSource;
    FProgressBar: TProgressBar;
    FDBCount: TSwCountQty;
    FHide: boolean;
    FFileName: string;    FQuery: TQuery;
    FCreateTable: TTable;
    FOpenTable: TTable;
    SaveFile: TextFile;
    FBuffer: integer;
    FFields:  TList;
    FSaveTitle: TSaveTitle;
    FSetBuffer: TSetBuffer;
    FSaveBuffer: TSaveBuffer;
    FOle: Variant;
    FOleB: Variant;
    FOleS: Variant;
    FSaveExcelOnly:boolean;
    FSaveDBFOnly:boolean;
    FMyTitle:string;
    procedure GetTable;
    procedure SetDBToText(Rows: integer; var Value: Variant);
    procedure SaveDBToTextTxt(Rows, Count: integer; Value: Variant);
    procedure DBToTextTxt;
    procedure SaveDBToTextCsv(Rows, Count: integer; Value: Variant);
    procedure DBToTextCsv;
    procedure SaveDBToTextPrn(Rows, Count: integer; Value: Variant);
    procedure DBToTextPrn;
    procedure SaveTitleDBToWord;
    procedure SaveDBToWord(Rows, Count: integer; Value: Variant);
    procedure DBToWord;
    procedure SaveTitleDBToDbase;
    procedure SetDBToDbase(Rows: integer; var Value: Variant);
    procedure DBToDbase;
    procedure DBToParadox;
    procedure SaveTitleDBToExcel;
    procedure SetDBToExcel(Rows: integer; var Value: Variant);
    procedure SaveDBToExcel(Rows, Count: integer; Value: Variant);
    procedure DBToExcel;
  protected
    { Protected declarations }
    function SetExcelField(Col, Row: integer): string;
    procedure SaveToFile(aType: integer; aFileName: string); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddFilter(aFilter: string);
    procedure SetDefaultExt( aDefault: string);
    procedure FilterClear;
    procedure Execute;
    property CountDataSet: TSwCountQty read FDBCount;
  published
    { Published declarations }
    property DataSource: TDataSource read FDataSource write FDataSource;
    property ProgressBar: TProgressBar read FProgressBar write FProgressBar;
    property Buffer: integer read FBuffer write FBuffer;
    property SaveExcelOnly: boolean read FSaveExcelOnly write FSaveExcelOnly;
    property SaveDBFOnly: boolean read FSaveDBFOnly write FSaveDBFOnly;
    property MyTitle: string read FMyTitle write FMyTitle;
  end;procedure Register;implementation
uses ComObj;procedure Register;
begin
  RegisterComponents('Data Controls', [TSwDBToFile]);
end;constructor TSwDBToFile.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDBCount:=TSwCountQty.Create(Self);
  FFields:=TList.Create;  FSaveDialog:=TSaveDialog.Create(Self);
  FSaveDialog.Title:='存储文件';
  FSaveExcelOnly:=false;
  FSaveDBFOnly:=false;
  FMyTitle:='';
  AddFilter('本文件(Tab 字符间隔)(*.TXT)|*.TXT|');
  AddFilter('MicroSoft Excel 4.0 (*.XLS)|*.XLS|');
  AddFilter('DBASE File (*.DBF)|*.DBF|');
  SetDefaultExt('*.TXT');
  FBuffer:=10;end;destructor TSwDBToFile.Destroy;
begin
  FSaveDialog.Free;
  FDBCount.Free;
  FFields.Free;
  inherited Destroy;
end;procedure TSwDBToFile.FilterClear;
begin
  FSaveDialog.Filter:='';
end;procedure TSwDBToFile.SetDefaultExt(aDefault: string);
begin
  FSaveDialog.DefaultExt:=aDefault;
end;procedure TSwDBToFile.AddFilter(aFilter: string);
var
  bFilter: string;
begin
  bFilter:=FSaveDialog.Filter;
  FSaveDialog.Filter:=bFilter+aFilter;
end;procedure TSwDBToFile.SaveToFile(aType: integer; aFileName: string);
var
  BookMark: TBookMark;
begin
  DataSource.DataSet.UpdateCursorPos;
  DataSource.DataSet.CursorPosChanged;  FFileName:=aFileName;
  FQuery:=TQuery(FDataSource.DataSet);
  BookMark:=FQuery.GetBook;
  FQuery.DisableControls;  if FProgressBar<>nil then begin
    if FDataSource.DataSet is TQuery then begin
      FDBCount.DataSet:=TQuery(FDataSource.DataSet);
      FDBCount.Open;
      FProgressBar.Max:=FDBCount.FieldByName('aCount').AsInteger;
      FProgressBar.Position:=0;
    end else begin
      FProgressBar.Max:=TTable(FDataSource.DataSet).RecordCount;
      FProgressBar.Position:=0;
    end;
  end;
  FHide:=False;  try
    if aType=1 then DBToTextTxt
    else if aType=2 then DBToExcel
    else if aType=3 then DBToDbase
  finally
    FDBCount.Close;
    FDBCount.UnPrepare;
    FQuery.EnableControls;
    FQuery.GotoBookMark(BookMark);
    FQuery.FreeBookMark(BookMark);
  end;
end;procedure TSwDBToFile.Execute;
var
  aFileName: string;
  FilterIndex: integer;
  MsgResult: Word;
begin
  if FDataSource=nil then raise ESwDBToFileError.Create('资料库没有设定');
  if FDataSource.State=dsInactive then raise ESwDBToFileError.Create('资料库没有打开');
  FSaveTitle:=nil;
  FSetBuffer:=nil;
  FSaveBuffer:=nil;  if SaveExcelOnly=true then begin
    FSaveDialog.filter:='Excel文件(*.XLS)|*.XLS|';
  end;
  if SaveDBFOnly=true then begin
    FSaveDialog.filter:='DBF文件(*.DBF)|*.DBF|';
  end;  FSaveDialog.FileName:=FMyTitle;  if FSaveDialog.Execute then begin
    aFileName:=FSaveDialog.FileName;
    FilterIndex:=FSaveDialog.FilterIndex;
    MsgResult:=mrYes;
    //if FileExists(aFileName) then
    //  MsgResult:=MessageDlg( aFileName+'文件已经存在，是否复盖？',mtConfirmation, [mbYes, mbNo], 0);
    if MsgResult=mrYes then
      if FSaveExcelOnly then
        SaveToFile(2, aFileName)
      else
      if FSaveDBFOnly then
        SaveToFile(3, aFileName)
      else
        SaveToFile(FilterIndex, aFileName);
  end;
end;procedure TSwDBToFile.SetDBToText(Rows: integer; var Value: Variant);
var
  iLoop: integer;
  Field: TField;
begin
  for iLoop:=0 to FFields.Count-1 do begin
    Field:=FFields[iLoop];
    if Field.DataType=ftDateTime then
      Value[Rows, iLoop+1]:=FormatDateTime('YYYY/MM/DD HH:NN:SS',Field.AsDateTime)
    else if Field.DataType=ftDate then
      Value[Rows, iLoop+1]:=FormatDateTime('YYYY/MM/DD',Field.AsDateTime)
    else if Field.DataType=ftTime then
      Value[Rows, iLoop+1]:=FormatDateTime('HH:NN:SS',Field.AsDateTime)
    else Value[Rows, iLoop+1]:=Field.Text;
  end;
end;procedure TSwDBToFile.SaveDBToTextTxt(Rows, Count: integer; Value: Variant);
var
  iLoop, iLoop1: integer;
  Line: string;
begin
  for iLoop:=1 to Rows do begin
    Line:='';
    for iLoop1:=1 to FFields.Count do begin
      Line:=Line+Value[iLoop, iLoop1];
      if iLoop1<>FFields.Count then Line:=Line+Chr(9);
    end;
    Writeln(SaveFile, Line);
  end;
end;procedure TSwDBToFile.DBToTextTxt;
begin
  FSetBuffer:=SetDBToText;
  FSaveBuffer:=SaveDBToTextTxt;
  AssignFile(SaveFile, FFileName);
  ReWrite(SaveFile);
  GetTable;
  CloseFile(SaveFile);
end;procedure TSwDBToFile.SaveDBToTextCsv(Rows, Count: integer; Value: Variant);
var
  iLoop, iLoop1: integer;
  Line: string;
begin
  for iLoop:=1 to Rows do begin
    Line:='';
    for iLoop1:=1 to FFields.Count do begin
      Line:=Line+Value[iLoop, iLoop1];
      if iLoop1<>FFields.Count then Line:=Line+',';
    end;
    Writeln(SaveFile, Line);
  end;
end;

Answer 3

procedure TSwDBToFile.DBToTextCsv;
begin
  FSetBuffer:=SetDBToText;
  FSaveBuffer:=SaveDBToTextCsv;
  AssignFile(SaveFile, FFileName);
  ReWrite(SaveFile);
  GetTable;
  CloseFile(SaveFile);
end;procedure TSwDBToFile.SaveDBToTextPrn(Rows, Count: integer; Value: Variant);
var
  iLoop, iLoop1: integer;
  Line: string;
begin
  for iLoop:=1 to Rows do begin
    Line:='';
    for iLoop1:=1 to FFields.Count do begin
      Line:=Line+Value[iLoop, iLoop1];
      if iLoop1<>FFields.Count then Line:=Line+' ';
    end;
    Writeln(SaveFile, Line);
  end;
end;procedure TSwDBToFile.DBToTextPrn;
begin
  FSetBuffer:=SetDBToText;
  FSaveBuffer:=SaveDBToTextPrn;
  AssignFile(SaveFile, FFileName);
  ReWrite(SaveFile);
  GetTable;
  CloseFile(SaveFile);
end;procedure TSwDBToFile.SaveTitleDBToWord;
var
  iLoop: integer;
  Line: string;
  Field: TField;
begin
  Line:='';
  for iLoop:=0 to FFields.Count-1 do begin
    Field:=FFields[iLoop];
    Line:=Line+Field.DisplayLabel;
    if iLoop<>FFields.Count-1 then Line:=Line+',';
  end;
  Line:=Line+Chr(13);
  FOle.Insert(Line);
end;procedure TSwDBToFile.SaveDBToWord(Rows, Count: integer; Value: Variant);
var
  iLoop, iLoop1: integer;
  Line: string;
begin
  for iLoop:=1 to Rows do begin
    Line:='';
    for iLoop1:=1 to FFields.Count do begin
      Line:=Line+Value[iLoop, iLoop1];
      if iLoop1<>FFields.Count then Line:=Line+',';
    end;
    Line:=Line+Chr(13);
    FOle.Insert(Line);
  end;
end;procedure TSwDBToFile.DBToWord;
var
  MsgResult: Word;
begin
  try
    MsgResult:=MessageDlg( ' MicroSoft Word',mtConfirmation, [mbYes, mbNo], 0);
    if MsgResult=mrYes then FHide:=True;    FSaveTitle:=SaveTitleDBToWord;
    FSetBuffer:=SetDBToText;
    FSaveBuffer:=SaveDBToWord;    FOle:=CreateOleObject('Word.Basic');
    FOle.AppHide;
    FOle.FileNewDefault;
    GetTable;
    try
      FOLE.FileSaveAs(Name:=FFileName, Format:=0);
      if FHide then begin
        FOLE.FileClose(1);
        FOLE.AppClose;
      end else FOLE.AppShow;
    except
      FOLE.AppClose;
      raise ESwDBToFileError.Create('无法保存'+FFileName);
    end;
  except
    raise ESwDBToFileError.Create('无法打开 Microsoft Word !');
  end;
end;procedure TSwDBToFile.SaveTitleDBToDbase;
var
  iLoop: integer;
  Field: TField;
  FieldDef: TFieldDef;
begin
  for iLoop:=0 to FFields.Count-1 do begin
    Field:=FFields[iLoop];
    //FCreateTable.FieldDefs.Add(Field.FieldName, Field.DataType,Field.Size, False);
    //FieldDef:=FCreateTable.FieldDefs.Find(Field.FieldName);
    FCreateTable.FieldDefs.Add(Field.FullName, Field.DataType,Field.Size, False);
    FieldDef:=FCreateTable.FieldDefs.Find(Field.FullName);
    FieldDef.CreateField(Self);
  end;
  FCreateTable.CreateTable;
  FOpenTable.Open;
end;procedure TSwDBToFile.SetDBToDbase(Rows: integer; var Value: Variant);
var
  iLoop: integer;
  Field: TField;
begin
  FOpenTable.Append;
  for iLoop:=0 to FFields.Count-1 do begin
    Field:=FFields[iLoop];
    FOpenTable.Fields[iLoop].Value:=Field.Value;
  end;
  FOpenTable.Post;
end;procedure TSwDBToFile.DBToDbase;
begin
  FSaveTitle:=SaveTitleDBToDbase;
  FSetBuffer:=SetDBToDbase;
  FCreateTable:=TTable.Create(nil);
  FOpenTable:=TTable.Create(nil);
  try
//    FCreateTable.TableType:=ttDBase;
    FCreateTable.TableType:=ttFoxPro;
    FCreateTable.DatabaseName:=ExtractFilePath(FFileName);
    FCreateTable.TableName:=ExtractFileName(FFileName);
    FOpenTable.TableType:=ttDBase;
    FOpenTable.DatabaseName:=ExtractFilePath(FFileName);
    FOpenTable.TableName:=ExtractFileName(FFileName);
    GetTable;
  finally
    FOpenTable.Close;
    FOpenTable.Free;
    FCreateTable.Close;
    FCreateTable.Free;
  end;
end;procedure TSwDBToFile.DBToParadox;
begin
  FSaveTitle:=SaveTitleDBToDbase;
  FSetBuffer:=SetDBToDbase;
  FCreateTable:=TTable.Create(nil);
  FOpenTable:=TTable.Create(nil);
  try
    FCreateTable.TableType:=ttParadox;
    FCreateTable.DatabaseName:=ExtractFilePath(FFileName);
    FCreateTable.TableName:=ExtractFileName(FFileName);
    FOpenTable.TableType:=ttParadox;
    FOpenTable.DatabaseName:=ExtractFilePath(FFileName);
    FOpenTable.TableName:=ExtractFileName(FFileName);
    GetTable;
  finally
    FOpenTable.Close;
    FOpenTable.Free;
    FCreateTable.Close;
    FCreateTable.Free;
  end;
end;function TSwDBToFile.SetExcelField(Col, Row: integer): string;
begin
  if (Col div 26)=0 then Result:=chr(65+(Col mod 26))+IntToStr(Row)
  else Result:=chr(65+(Col div 26))+chr(65+(Col mod 26))+IntToStr(Row);
end;procedure TSwDBToFile.SaveTitleDBToExcel;
var
  iLoop: integer;
  Field: TField;
  iBegin:integer;
begin
  if FMyTitle<>'' then
    iBegin:=3
  else
    iBegin:=1;
  for iLoop:=0 to FFields.Count-1 do begin
    Field:=FFields[iLoop];
    FOleS.Cells[iBegin, iLoop+1].Value:=Field.displaylabel;
  end;
end;procedure TSwDBToFile.SetDBToExcel(Rows: integer; var Value: Variant);
var
  iLoop: integer;
  Field: TField;
begin
  for iLoop:=0 to FFields.Count-1 do begin
    Field:=FFields[iLoop];
    if Field.DataType=ftDateTime then
      Value[Rows, iLoop+1]:=FormatDateTime('YYYY/MM/DD HH:NN:SS',Field.AsDateTime)
    else if Field.DataType=ftDate then
      Value[Rows, iLoop+1]:=FormatDateTime('YYYY/MM/DD',Field.AsDateTime)
    else if Field.DataType=ftTime then
      Value[Rows, iLoop+1]:=FormatDateTime('HH:NN:SS',Field.AsDateTime)
    else if Field.DataType=ftString then
      Value[Rows, iLoop+1]:=#39+Field.Text
    else Value[Rows, iLoop+1]:=Field.Text;
  end;
end;procedure TSwDBToFile.SaveDBToExcel(Rows, Count: integer; Value: Variant);
var
  sCol, sRow, eCol, eRow: integer;
begin
  sRow:=(Count-Rows)+2;
  sCol:=1;
  eRow:=Count+1;
  eCol:=FFields.Count;
  try
    FOleS.Range[FOleS.Cells[sRow, sCol], FOleS.Cells[eRow, eCol]].Value:=Value;
  except
    FOleS.Range[FOleS.Cells[sRow, sCol], FOleS.Cells[eRow, eCol]]:=Value;
  end;
end;procedure TSwDBToFile.DBToExcel;
var
  MsgResult: Integer;
begin
 // MsgResult:= MessageDlg( '是否打开 MicroSoft Excel',mtConfirmation, [mbYes, mbNo], 0);
//  MsgResult :=Application.MessageBox('是否打开 MicroSoft Excel','提示',MB_YESNO+MB_ICONINFORMATION);
 // if MsgResult<>IdYes then FHide:=True;
  FHide:=True;
  FSaveTitle:=SaveTitleDBToExcel;
  FSetBuffer:=SetDBToExcel;
  FSaveBuffer:=SaveDBToExcel;
  try
    FOle:=CreateOleObject('Excel.Application');
    FOleB:=FOle.WorkBooks.Add;
    FOleS:=FOle.WorkSheets.Add;
    if FMyTitle<>'' then begin
      FOleS.Cells[1, 1].value:=FMyTitle;
      FOleS.Cells[1, 1].Font.size:=20;
      FOleS.Cells[1, 1].Font.bold:=true;
      //FOleS.Cells[1, 1].alignment:=2;
    end;    FOle.Visible:=False;
    GetTable;
    try
      FOleS.SaveAs(FFileName);
      if FHide then FOle.Quit
      else FOle.Visible:=True;
    except
      FOle.Quit;
      raise ESwDBToFileError.Create('无法存储 '+FFileName);
    end;
  except
    try
      FOle:=CreateOleObject('Excel.Application.8');
      FOleB:=FOle.WorkBooks.Add;
      FOleS:=FOle.WorkSheets.Add;
      FOle.Visible:=False;
      GetTable;
      try
        FOleS.SaveAs(FFileName);
        if FHide then FOle.Quit
        else FOle.Visible:=True;
      except
        FOle.Quit;
        raise ESwDBToFileError.Create('无法存储 '+FFileName);
      end;
    except
      raise ESwDBToFileError.Create('无法启动 Excel !');
    end;
  end;
end;procedure TSwDBToFile.GetTable;
var
  iLoop, Rows, Count: integer;
  Field: TField;
  Value: Variant;
begin
  if FBuffer=0 then FBuffer:=FProgressBar.Max;  FFields.Clear;
  for iLoop:=0 to FQuery.FieldCount-1 do begin
    Field:=FQuery.Fields[iLoop];
    if (Field.Visible) and (Field.dataType in
       [ftString,ftSmallint,ftInteger,ftWord, ftBoolean,ftFloat,ftCurrency,
        ftDate,ftTime,ftDateTime,ftAutoInc]) then FFields.Add(FQuery.Fields[iLoop]);
  end;
  if Assigned(FSaveTitle) then FSaveTitle;  Value:=VarArrayCreate([1, FBuffer, 1, FFields.Count], varVariant);
  if FMyTitle<>'' then
    begin
      Rows:=2;
      Count:=2;
    end
  else
    begin
      Rows:=0;
      Count:=0;
    end;
  FQuery.First;
  while not FQuery.EOF do begin
    inc(Rows);
    inc(Count);
    if FProgressBar<>nil then FProgressBar.Position:=Count;
    if Assigned(FSetBuffer) then FSetBuffer(Rows, Value);
    if Rows=FBuffer then begin
      if Assigned(FSaveBuffer) then FSaveBuffer(Rows, Count, Value);
      Rows:=0;
    end;
    FQuery.Next;
  end;
  if Rows>0 then begin
    if Assigned(FSaveBuffer) then FSaveBuffer(Rows, Count, Value);
  end;  if Assigned(FSaveTitle) then FSaveTitle;
end;end.//不要再问我，批量如何处理，人不能太懒！否则下次没有人再愿意帮你！