excelwithodbc.pas

将DataGrid或dxDbGrid或cxGrid或数据集中的数据导出到Excel表格中

//导出DBGrid

procedure TExcelWithOdbc.DBGridExport(OutGrid: TDBGrid; Con1: TADOConnection;
  SheetName: string; SelectFields, OnlySelect: Boolean);
var
  Qry1: TADOQuery;
  SqlStr, StringValue: string;
  i, j, SelectCount: integer;
  OutField: array of TOutField;
  Book1: Pointer;
begin
  OutGrid.DataSource.DataSet.DisableControls;
  //保存标签
  Book1 := OutGrid.DataSource.DataSet.GetBookmark;
  //创建查询
  Qry1 := TADOQuery.Create(Application);
  Qry1.Connection := Con1;
  //分析字段
  fmSelectFields := TfmSelectFields.Create(Application.MainForm);
  for i := 0 to OutGrid.Columns.Count - 1 do
  begin
    if (OutGrid.Columns[i].Visible) and (OutGrid.Columns[i].Field <> nil) then
    begin
      with fmSelectFields.ListView1.Items.Add do
      begin
        Caption := OutGrid.Columns[i].Title.Caption;
        SubItems.Add(inttostr(OutGrid.Columns[i].Field.Index));
        case OutGrid.Columns[i].Field.DataType of
          ftAutoInc, ftSmallint, ftInteger:
            begin
              SubItems.Add(inttostr(2));
              SubItems.Add('int');
            end;
          ftBCD, ftFloat:
            begin
              SubItems.Add(inttostr(2));
              SubItems.Add('numeric');
            end;
          ftDateTime, ftDate, ftTime:
            begin
              SubItems.Add(inttostr(4));
              SubItems.Add('datetime');
            end;
          ftString:
            begin
              SubItems.Add(inttostr(1));
              if OutGrid.Columns[i].Field.Size > 255 then
                SubItems.Add('memo')
              else
                SubItems.Add('varchar(255)');
            end;
          ftMemo, ftFmtMemo:
            begin
              SubItems.Add(inttostr(1));
              SubItems.Add('memo');
            end;
        else
          begin
            SubItems.Add(inttostr(3));
            SubItems.Add('varchar(255)');
          end;
        end;
        Checked := True;
      end;
    end;
  end;
  try
    SelectCount := 0;
    if SelectFields then
    begin
      if not (fmSelectFields.ShowModal = mrOK) then
        Exit;
      for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do
      begin
        if fmSelectFields.ListView1.Items[i].Checked then
          SelectCount := SelectCount + 1;
      end;
    end;

    if FShowProgress then
    begin
      if OnlySelect and (OutGrid.SelectedRows.Count > 1) then
        i := OutGrid.SelectedRows.Count
      else
        i := OutGrid.DataSource.DataSet.RecordCount;
      CreateProgress('输出“' + SheetName + '”到文件“' +
        ExtractFileName(FExcelFileName) + '”！', i);
    end;
    //添加字段名
    SqlStr := 'CREATE TABLE [' + SheetName + '] (';
    if (not SelectFields) or (SelectCount = 0) or (SelectCount =
      fmSelectFields.ListView1.Items.Count) then
    begin
      SelectCount := fmSelectFields.ListView1.Items.Count;
      SetLength(OutField, SelectCount);
      for i := 0 to SelectCount - 1 do
      begin
        SqlStr := SqlStr + '[' + fmSelectFields.ListView1.Items[i].Caption + '] '
          + fmSelectFields.ListView1.Items[i].SubItems[2] + ', ';
        OutField[i].FieldIndex :=
          StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]);
        OutField[i].FieldType :=
          StrToInt(fmSelectFields.ListView1.Items[i].SubItems[1]);
      end;
    end
    else
    begin
      SetLength(OutField, SelectCount);
      j := 0;
      for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do
      begin
        if fmSelectFields.ListView1.Items[i].Checked then
        begin
          SqlStr := SqlStr + '[' + fmSelectFields.ListView1.Items[i].Caption +
            '] ' + fmSelectFields.ListView1.Items[i].SubItems[2] + ', ';
          OutField[j].FieldIndex :=
            StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]);
          OutField[j].FieldType :=
            StrToInt(fmSelectFields.ListView1.Items[i].SubItems[1]);
          inc(j);
        end;
      end;
    end;
    Delete(SqlStr, length(SqlStr) - 1, 2);
    SqlStr := SqlStr + ')';

    //创建Sheet;
    Qry1.SQL.Text := SqlStr;
    Qry1.ExecSQL;

    //插入记录
    if OnlySelect and (OutGrid.SelectedRows.Count > 1) then
    begin
      with OutGrid.DataSource.DataSet do
      begin
        for j := 0 to OutGrid.SelectedRows.Count - 1 do
        begin
          OutGrid.DataSource.DataSet.GotoBookmark(Pointer(OutGrid.SelectedRows.Items[j]));
          SqlStr := 'INSERT INTO [' + SheetName + '] values(';
          for i := 0 to SelectCount - 1 do
          begin
            if Fields[OutField[i].FieldIndex].IsNull then
            begin
              SqlStr := SqlStr + 'null,';
            end
            else
            begin
              case OutField[i].FieldType of
                1:
                  begin
                    StringValue := Fields[OutField[i].FieldIndex].AsString;
                    StringValue := StringReplace(StringValue, ':', '：',
                      [rfReplaceAll]);
                    StringValue := StringReplace(StringValue, '''', '''''',
                      [rfReplaceAll]);
                    SqlStr := SqlStr + '''' + StringValue + ''',';
                  end;
                2: SqlStr := SqlStr + Fields[OutField[i].FieldIndex].AsString +
                  ',';
                3: SqlStr := SqlStr + '''' +
                  Fields[OutField[i].FieldIndex].AsString + ''',';
                4: SqlStr := SqlStr +
                  FloatToStr(Fields[OutField[i].FieldIndex].AsFloat) + ',';
              end;
            end;
          end;
          System.Delete(SqlStr, length(SqlStr), 1);
          SqlStr := SqlStr + ')';
          Qry1.SQL.Text := SqlStr;
          Qry1.ExecSQL;
          if FShowProgress then
            UpdateProgress(j + 1);
        end;
      end;
    end
    else
    begin
      with OutGrid.DataSource.DataSet do
      begin
        First;
        while not Eof do
        begin
          SqlStr := 'INSERT INTO [' + SheetName + '] values(';
          for i := 0 to SelectCount - 1 do
          begin
            if Fields[OutField[i].FieldIndex].IsNull then
            begin
              SqlStr := SqlStr + 'null,';
            end
            else
            begin
              case OutField[i].FieldType of
                1:
                  begin
                    StringValue := Fields[OutField[i].FieldIndex].AsString;
                    StringValue := StringReplace(StringValue, ':', '：',
                      [rfReplaceAll]);
                    StringValue := StringReplace(StringValue, '''', '''''',
                      [rfReplaceAll]);
                    SqlStr := SqlStr + '''' + StringValue + ''',';
                  end;
                2: SqlStr := SqlStr + Fields[OutField[i].FieldIndex].AsString +
                  ',';
                3: SqlStr := SqlStr + '''' +
                  Fields[OutField[i].FieldIndex].AsString + ''',';
                4: SqlStr := SqlStr +
                  FloatToStr(Fields[OutField[i].FieldIndex].AsFloat) + ',';
              end;
            end;
          end;
          System.Delete(SqlStr, length(SqlStr), 1);
          SqlStr := SqlStr + ')';
          Qry1.SQL.Text := SqlStr;
          Qry1.ExecSQL;
          Next;
          if FShowProgress then
            UpdateProgress(RecNo + 1);
        end;
      end;
    end;
  finally
    fmSelectFields.Free;
    fmSelectFields := nil;
    Qry1.Free;
    OutGrid.DataSource.DataSet.GotoBookmark(Book1);
    OutGrid.DataSource.DataSet.EnableControls;
    if FShowProgress then
      DeleteProgress;
  end;
end;

//导出DxGrid

procedure TExcelWithOdbc.DxGridExport(OutGrid: TDxDBGrid; Con1: TADOConnection;
  SheetName: string; SelectFields, OnlySelect: Boolean);
var
  Qry1: TADOQuery;
  SqlStr, StringValue: string;
  i, j, SelectCount: integer;
  OutField: array of TOutField;
  Book1: Pointer;
begin
  OutGrid.DataSource.DataSet.DisableControls;
  //保存标签
  Book1 := OutGrid.DataSource.DataSet.GetBookmark;
  //创建查询
  Qry1 := TADOQuery.Create(Application);
  Qry1.Connection := Con1;
  //分析字段
  fmSelectFields := TfmSelectFields.Create(Application.MainForm);
  for i := 0 to OutGrid.ColumnCount - 1 do
  begin
    if (OutGrid.Columns[i].Visible) and (OutGrid.Columns[i].Field <> nil) then
    begin
      with fmSelectFields.ListView1.Items.Add do
      begin
        Caption := OutGrid.Columns[i].Caption;
        SubItems.Add(inttostr(OutGrid.Columns[i].Field.Index));
        case OutGrid.Columns[i].Field.DataType of
          ftAutoInc, ftSmallint, ftInteger:
            begin
              SubItems.Add(inttostr(2));
              SubItems.Add('int');
            end;
          ftBCD, ftFloat:
            begin
              SubItems.Add(inttostr(2));
              SubItems.Add('numeric');
            end;
          ftDateTime, ftDate, ftTime:
            begin
              SubItems.Add(inttostr(4));
              SubItems.Add('datetime');
            end;
          ftString:
            begin
              SubItems.Add(inttostr(1));
              if OutGrid.Columns[i].Field.Size > 255 then
                SubItems.Add('memo')
              else
                SubItems.Add('varchar(255)');
            end;
          ftMemo, ftFmtMemo:
            begin
              SubItems.Add(inttostr(1));
              SubItems.Add('memo');
            end;
        else
          begin
            SubItems.Add(inttostr(3));
            SubItems.Add('varchar(255)');
          end;
        end;
        Checked := True;
      end;
    end;
  end;
  try
    SelectCount := 0;
    if SelectFields then
    begin
      if not (fmSelectFields.ShowModal = mrOK) then
        Exit;
      for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do
      begin
        if fmSelectFields.ListView1.Items[i].Checked then
          SelectCount := SelectCount + 1;
      end;
    end;

    if FShowProgress then
    begin
      if OnlySelect and (OutGrid.SelectedCount > 1) then
        i := OutGrid.SelectedCount
      else
        i := OutGrid.DataSource.DataSet.RecordCount;
      CreateProgress('输出“' + SheetName + '”到文件“' +
        ExtractFileName(FExcelFileName) + '”！', i);
    end;
    //添加字段名
    SqlStr := 'CREATE TABLE [' + SheetName + '] (';
    if (not SelectFields) or (SelectCount = 0) or (SelectCount =
      fmSelectFields.ListView1.Items.Count) then
    begin
      SelectCount := fmSelectFields.ListView1.Items.Count;
      SetLength(OutField, SelectCount);
      for i := 0 to SelectCount - 1 do
      begin
        SqlStr := SqlStr + '[' + fmSelectFields.ListView1.Items[i].Caption + '] '
          + fmSelectFields.ListView1.Items[i].SubItems[2] + ', ';
        OutField[i].FieldIndex :=
          StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]);
        OutField[i].FieldType :=
          StrToInt(fmSelectFields.ListView1.Items[i].SubItems[1]);
      end;
    end
    else
    begin
      SetLength(OutField, SelectCount);
      j := 0;
      for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do
      begin
        if fmSelectFields.ListView1.Items[i].Checked then
        begin
          SqlStr := SqlStr + '[' + fmSelectFields.ListView1.Items[i].Caption +
            '] ' + fmSelectFields.ListView1.Items[i].SubItems[2] + ', ';
          OutField[j].FieldIndex :=
            StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]);
          OutField[j].FieldType :=
            StrToInt(fmSelectFields.ListView1.Items[i].SubItems[1]);
          inc(j);
        end;
      end;
    end;
    Delete(SqlStr, length(SqlStr) - 1, 2);
    SqlStr := SqlStr + ')';

    //创建Sheet;
    Qry1.SQL.Text := SqlStr;
    Qry1.ExecSQL;

    //插入记录
    if OnlySelect and (OutGrid.SelectedCount > 1) then
    begin
      with OutGrid.DataSource.DataSet do
      begin
        for j := 0 to OutGrid.SelectedCount - 1 do
        begin
          OutGrid.DataSource.DataSet.GotoBookmark(Pointer(OutGrid.SelectedRows[j]));
          SqlStr := 'INSERT INTO [' + SheetName + '] values(';
          for i := 0 to SelectCount - 1 do
          begin
            if Fields[OutField[i].FieldIndex].IsNull then
            begin
              SqlStr := SqlStr + 'null,';
            end
            else
            begin
              case OutField[i].FieldType of
                1:
                  begin
                    StringValue := Fields[OutField[i].FieldIndex].AsString;
                    StringValue := StringReplace(StringValue, ':', '：',
                      [rfReplaceAll]);
                    StringValue := StringReplace(StringValue, '''', '''''',
                      [rfReplaceAll]);
                    SqlStr := SqlStr + '''' + StringValue + ''',';
                  end;
                2: SqlStr := SqlStr + Fields[OutField[i].FieldIndex].AsString +
                  ',';
                3: SqlStr := SqlStr + '''' +
                  Fields[OutField[i].FieldIndex].AsString + ''',';
                4: SqlStr := SqlStr +
                  FloatToStr(Fields[OutField[i].FieldIndex].AsFloat) + ',';
              end;
            end;
          end;
          System.Delete(SqlStr, length(SqlStr), 1);
          SqlStr := SqlStr + ')';
          Qry1.SQL.Text := SqlStr;
          Qry1.ExecSQL;
          if FShowProgress then
            UpdateProgress(j + 1);
        end;
      end;
    end
    else
    begin
      with OutGrid.DataSource.DataSet do
      begin
        First;
        while not Eof do
        begin
          SqlStr := 'INSERT INTO [' + SheetName + '] values(';
          for i := 0 to SelectCount - 1 do
          begin
            if Fields[OutField[i].FieldIndex].IsNull then
            begin
              SqlStr := SqlStr + 'null,';
            end
            else
            begin
              case OutField[i].FieldType of
                1:
                  begin
                    StringValue := Fields[OutField[i].FieldIndex].AsString;
                    StringValue := StringReplace(StringValue, ':', '：',
                      [rfReplaceAll]);
                    StringValue := StringReplace(StringValue, '''', '''''',
                      [rfReplaceAll]);
                    SqlStr := SqlStr + '''' + StringValue + ''',';
                  end;
                2: SqlStr := SqlStr + Fields[OutField[i].FieldIndex].AsString +
                  ',';
                3: SqlStr := SqlStr + '''' +
                  Fields[OutField[i].FieldIndex].AsString + ''',';
                4: SqlStr := SqlStr +
                  FloatToStr(Fields[OutField[i].FieldIndex].AsFloat) + ',';
              end;
            end;
          end;
          System.Delete(SqlStr, length(SqlStr), 1);
          SqlStr := SqlStr + ')';
          Qry1.SQL.Text := SqlStr;
          Qry1.ExecSQL;
          Next;
          if FShowProgress then
            UpdateProgress(RecNo + 1);
        end;
      end;
    end;
  finally
    fmSelectFields.Free;
    fmSelectFields := nil;
    Qry1.Free;
    OutGrid.DataSource.DataSet.GotoBookmark(Book1);
    OutGrid.DataSource.DataSet.EnableControls;
    if FShowProgress then
      DeleteProgress;
  end;
end;

end.