unitexportexcel.pas

此程序是可以将数据库表中的数据导出转为EXCEL、也可将EXCEL中的数据导入至数据库的表中。

unit UnitExportExcel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, DBClient, Grids, DBGridEh, ExtCtrls, ComCtrls,
  DBCtrls, ADODB, Menus, GridsEh;

type
  TFrmExportExcel = class(TForm)
    OpenDialog1: TOpenDialog;
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    Panel1: TPanel;
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet3: TTabSheet;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    Panel3: TPanel;
    DG_PZ: TDBGridEh;
    Splitter1: TSplitter;
    DBGridEh1: TDBGridEh;
    MEMO_Info: TMemo;
    Label1: TLabel;
    ComboBox1: TComboBox;
    CDS_PZ: TClientDataSet;
    DS_PZ: TDataSource;
    DFIeldValue: TDBMemo;
    SFIeldValue: TDBMemo;
    ADO_Data: TADOQuery;
    Button2: TButton;
    Pbar: TProgressBar;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CDS_PZNewRecord(DataSet: TDataSet);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure ADO_DataAfterOpen(DataSet: TDataSet);
    procedure Button2Click(Sender: TObject);
    procedure CDS_PZBeforePost(DataSet: TDataSet);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure ADO_DataPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
  private
    { Private declarations }
  public
    { Public declarations }
    
  end;

var
  FrmExportExcel: TFrmExportExcel;

implementation

uses gobalExportExcel, UnitDataModule;

{$R *.dfm}

procedure TFrmExportExcel.Button1Click(Sender: TObject);
var
  Strfile:String;
  tmpL:TStrings;
  i:integer;
begin
  if  OpenDialog1.Execute then
  begin
    Strfile:=OpenDialog1.FileName;
    Application.ProcessMessages;
    Strfile:=ExportExceltoCSVFile(Strfile,'D:\');
    if length(Strfile)>0 then
    begin
      tmpL:=TStringList.Create;
      try
        tmpL.Text:=Strfile;
        tmpL.Text:=CheckCSVText(tmpL);
        tmpl.text:=GenToTextDataSet(tmpL,ClientDataSet1);
        CDS_PZ.EmptyDataSet;
        DG_PZ.Columns[0].KeyList.Clear;
        DG_PZ.Columns[0].PickList.Clear;
        DBGridEh1.Columns[0].Title.Caption:='不导入';

        for i:=1 to tmpL.Count do
        begin
          if tmpL.Strings[i-1]='0' then
            DBGridEh1.Columns[i].Width:=4
          else
            DBGridEh1.Columns[i].Width:=DBGridEh1.Canvas.TextWidth('A')*Strtoint(tmpL.Strings[i-1]);
          //DBGRID2中导入所有的字段
          DG_PZ.Columns[0].KeyList.Add(DBGridEh1.Columns[i].FieldName);
          DG_PZ.Columns[0].PickList.Add(DBGridEh1.Columns[i].FieldName);
        end;
      finally
        tmpL.Free;
      end;
    end
    else
      MsgBox('无法读取excel文件中的内容!','提示信息',-1); 

  end;
end;

procedure TFrmExportExcel.FormCreate(Sender: TObject);
begin
  CreateFieldNameDataSet(CDS_PZ);
    dm.ADOConnection1.GetTableNames(ComboBox1.Items,false); 
end;

procedure TFrmExportExcel.CDS_PZNewRecord(DataSet: TDataSet);
begin
  DataSet.FieldByName('IsKey').AsBoolean:=false;

end;

procedure TFrmExportExcel.ComboBox1Change(Sender: TObject);
var
  ss:String;
begin
  ss:=ComboBox1.Text;
  if ComboBox1.Items.IndexOf(ss)>=0 then
  begin
    Screen.Cursor:=crSQLWait;
    try
      ADO_Data.Close;
      ADO_Data.SQL.Text:='Select top 0 * from '+ss;
      ADO_Data.Open;
      Screen.Cursor:=crArrow;
    except
      ShowMessage(ss+'不是表');
      Screen.Cursor:=crArrow;
    end;
  end;
end;

procedure TFrmExportExcel.ComboBox1KeyPress(Sender: TObject;
  var Key: Char);
var
  ss:String;
begin
  if key=#13 then
  begin
    ss:=ComboBox1.Text;
    Screen.Cursor:=crSQLWait;
    try
      ADO_Data.Close;
      ADO_Data.SQL.Text:='Select top 0 * from '+ss;
      ADO_Data.Open;
      Screen.Cursor:=crArrow;
    except
      ShowMessage(ss+'不是表');
      Screen.Cursor:=crArrow;
    end;
  end;
end;

procedure TFrmExportExcel.ADO_DataAfterOpen(DataSet: TDataSet);
var
  i:integer;
begin
  //添加字段信息
  screen.Cursor:=crSQLWait;
  try
    DG_PZ.Columns[1].KeyList.Clear;
    DG_PZ.Columns[1].PickList.Clear;
    with DataSet do
    for i:=0 to Fields.Count-1 do
    begin
      DG_PZ.Columns[1].KeyList.Add(Fields[i].FieldName);
      DG_PZ.Columns[1].PickList.Add(Fields[i].FieldName);
    end;
  finally
     Screen.Cursor:=crArrow;
  end;
end;

procedure TFrmExportExcel.Button2Click(Sender: TObject);
var
  tmpSL,tmpDL:TStrings;
  i:integer;
  tmpss,TmpErr:String;
  tmpSFN,tmpDFN:String;
  m,n,Imax,iCount:Integer;
begin
  if MsgBox('是否配置数据转换信息完毕(是/否)?','确认信息',MB_YESNO+MB_ICONQUESTION)=IDNO then
    exit;
  if not ADO_Data.Active then
  begin
    MsgBox('请选择表','',-1);
    exit;
  end;

  if not CDS_PZ.Active or CDS_PZ.IsEmpty then
  begin
    MsgBox('请填写转换信息','',-1);
    exit;
  end;
  with ClientDataSet1 do
  begin
    if not Active or IsEmpty then
    begin
      MsgBox('请选择Excel文件','',-1);
      exit;
    end;
    PageControl1.ActivePageIndex:=1;
    MEMO_Info.Clear;
    Screen.Cursor:=crSQLWait;
    tmpSL:=TStringList.Create;
    tmpDL:=TStringList.Create;
    iCount:=CDS_PZ.RecordCount+1;
    iMax:=ClientDataSet1.RecordCount*iCount;
    Pbar.Position:=0;
    Pbar.Max:=imax;
    m:=0;
    n:=0;
    try
      First;
      while not Eof do
      begin
        inc(m);
        if FieldByName('Checked').AsBoolean then
        Begin
          Next;
          Continue;
        end;
        if ADO_Data.State in [dsInsert,DsEdit] then
          ADO_Data.Cancel;
        ADO_Data.Append;
        tmpErr:='';
        n:=0;
        CDS_PZ.First;
        while not CDS_PZ.Eof do
        begin
          inc(n);
          Application.ProcessMessages;
          Pbar.Position:=m*iCount+n;
          tmpSL.Text:=CDS_PZ.fieldByName('SFieldValue').AsString;
          tmpDL.Text:=CDS_PZ.fieldByName('DFieldValue').AsString;
          tmpSFN:=CDS_PZ.fieldByName('SFieldName').AsString;
          tmpDFN:=CDS_PZ.fieldByName('DFieldName').AsString;

          tmpss:=fieldbyName(tmpSFN).AsString;
          if length(tmpss)=0 then
            tmpss:='空';
          TmpErr:=TmpErr+tmpss;
          i:=tmpSL.IndexOf(tmpss);
          if (i>=0) and (tmpDL.count>i) then
            ADO_Data.FieldByName(tmpDFN).Value:=tmpDL.Strings[i]
          else
            ADO_Data.FieldByName(tmpDFN).Value:=fieldbyName(tmpSFN).Value;
          CDS_PZ.Next;
        end;
        try
          ADO_Data.Post;
          MEMO_Info.Lines.Add('导入第'+inttoStr(m)+'行成功!');
          Edit;
          FieldByName('checked').AsBoolean:=true;
          post;
          Next;
        except
          ADO_Data.Cancel;
          MEMO_Info.Lines.Add('导入第'+inttoStr(m)+'行错误:'+TmpErr);
          Next;
        end;
      end; {end whil...}
    finally
      tmpSL.free;
      tmpDL.Free;
      Pbar.Position:=0;
      Screen.Cursor:=crArrow;
    end;
  end; {end with...}
end;

procedure TFrmExportExcel.CDS_PZBeforePost(DataSet: TDataSet);
begin
  if Length(DataSet.FieldByName('SFieldName').AsString)=0 then
  begin
    MsgBox('Excel字段不能为空!','错误信息',MB_OK+MB_ICONERROR);
    Abort;
  end;
  if Length(DataSet.FieldByName('DFieldName').AsString)=0 then
  begin
    MsgBox('表字段不能为空!','错误信息',MB_OK+MB_ICONERROR);
    Abort;
  end;
end;

procedure TFrmExportExcel.N1Click(Sender: TObject);
begin
  CDS_PZ.SaveToFile('D:\aaa.XML'); 
end;

procedure TFrmExportExcel.N2Click(Sender: TObject);
begin
  CDS_PZ.LoadFromFile('D:\aaa.XML'); 
end;

procedure TFrmExportExcel.ADO_DataPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  MEMO_Info.Lines.Add('提交数据错误:'+E.Message);
  Action:=daFail; 
end;

end.