如何使用Delphi(任何版本)仅将某些列从ADOQuery导出到Excel? [英] How can I export only some columns from that ADOQuery to Excel using Delphi (any version)?

问题描述

在Delphi中，我有一个带有多个列(字段)的ADOQuery(TADOQuery，绑定到其他可视组件).我可以将所有数据(行和列)导出到Excel文件.我正在使用OleVariant，类似于ovRange.CopyFromRecordset(数据，行，列).如何使用Delphi(任何版本)仅将ADOQuery中的某些列导出到Excel?

I have an ADOQuery (TADOQuery, bound to other visual components) with multiple columns (fields), in Delphi. I can export all the data (rows and columns) to an Excel file. I'm using OleVariant, something like ovRange.CopyFromRecordset (Data, Rows, Cols). How can I export only some columns from an ADOQuery to Excel using Delphi (any version)?

procedure ExportRecordsetToMSExcel(const DestName: string; Data: _Recordset);
var
  ovExcelApp: OleVariant;
  ovExcelWorkbook: OleVariant;
  ovWS: OleVariant;
  ovRange: OleVariant;
  FileFormat: Integer;
  Cols, Rows: Cardinal;
begin
  FileFormat := ExcelFileTypeToInt(xlWorkbookDefault);
  ovExcelApp := CreateOleObject('Excel.Application'); // If Excel isnt installed will raise an exception

  try
    ovExcelWorkbook := ovExcelApp.WorkBooks.Add;
    ovWS := ovExcelWorkbook.Worksheets.Item[1]; // go to first worksheet
    ovWS.Activate;
    ovWS.Select;

    Rows := Data.RecordCount;
    Cols := Data.Fields.Count; // I don't want all of them, just some, maybe the ones that are visible

    ovRange := ovWS.Range['A1', 'A1']; // go to first cell
    ovRange.Resize[Rows, Cols]; //ovRange.Resize[Data.RecordCount, Data.Fields.Count];

    ovRange.CopyFromRecordset(Data, Rows, Cols); // this copy the entire recordset to the selected range in excel

    ovWS.SaveAs(DestName, FileFormat, '', '', False, False);
  finally
    ovExcelWorkbook.Close(SaveChanges := False);
    ovWS := Unassigned;
    ovExcelWorkbook := Unassigned;

    ovExcelApp.Quit;
    ovExcelApp := Unassigned;
  end;
end;
...
  ExportRecordsetToMSExcel('c:\temp\test.xlsx', ADOQuery.Recordset);

已解决(基于@MartynA和@PeterWolf的答案的工作解决方案):

Resolved (working solution based on @MartynA and @PeterWolf's answers):

procedure ExportRecordsetToMSExcel(const DestName: string; ADOQuery: TADOQuery; const Fields: array of string); overload;

  procedure CopyData( { out } var Values: OleVariant);
  var
    R, C: Integer;
    FieldsNo: array of Integer;
    L1, H1, L2, H2: Integer;
    V: Variant;
    F: TField;
  begin
    L1 := 0;
    H1 := ADOQuery.RecordSet.RecordCount + L1 - 1;
    L2 := Low(Fields); // 0
    H2 := High(Fields);

    SetLength(FieldsNo, Length(Fields));
    for C := L2 to H2 do
      FieldsNo[C] := ADOQuery.FieldByName(Fields[C]).Index;

    Values := VarArrayCreate([L1, H1, L2, H2], varVariant);

    for R := L1 to H1 do begin
      for C := L2 to H2 do
        Values[R, C] := ADOQuery.RecordSet.Fields[FieldsNo[C]].Value;

      ADOQuery.RecordSet.MoveNext();
    end;
  end;

var
  ovExcelApp: OleVariant;
  ovExcelWorkbook: OleVariant;
  ovWS: OleVariant;
  ovRange: OleVariant;
  Values: OleVariant;
  RangeStr: string;
  Rows, Cols: Integer;
begin
  CopyData(Values);
  try
    ovExcelApp := CreateOleObject('Excel.Application');
    try
      ovExcelWorkbook := ovExcelApp.WorkBooks.Add;
      ovWS := ovExcelWorkbook.ActiveSheet;

      Rows := ADOQuery.RecordSet.RecordCount;
      Cols := Length(Fields);
      RangeStr := ToRange(1, 1, Rows, Cols); // Ex: 'A1:BE100'

      ovRange := ovWS.Range[RangeStr];
      ovRange.Value := Values;

      ovWS.SaveAs(FileName := DestName);
    finally
      ovExcelWorkbook.Close(SaveChanges := False);
      ovWS := Unassigned;
      ovExcelWorkbook := Unassigned;

      ovExcelApp.Quit;
      ovExcelApp := Unassigned;
    end;
  finally
    VarClear(Values);
  end;
end;

推荐答案

更新

我有义务向Peter Wolf建议使用Excel的 Transpose 函数来避免在初始代码中逐个元素地复制.尝试实现它时，我发现我遇到了 Transpose 的一个已知问题，即它抛出了类型不匹配".如果在转置的数组中遇到Null，则返回错误.下面更新的代码可以解决该问题，并且还从OP的代码中删除了许多行，这些行在我看来是多余的.

I am obliged to Peter Wolf for the suggestion to use Excel's Transpose function to avoid the element by element copying in my initial code. Trying to implement it, I found I ran into a known problem with Transpose, that it throws a "Type mismatch" error if it encounters a Null in the array it is transposing. The updated code below has a work-around to this problem, and also removes a number of lines from the OP's code which seemed to me to be superfluous.

====

您可以执行所要的操作，而无需使用在AdoIntf.Pas中声明为记录集的 GetRows 方法来更改用于检索记录集的SQL，

You can do what you are asking, without changing the SQL used to retrieve your recordset by using the recordset's GetRows method which is declared in AdoIntf.Pas as

function GetRows(Rows: Integer; Start: OleVariant; Fields: OleVariant): OleVariant; safecall;

这可以将记录集中的一个或多个命名列中的值检索到一个变量数组中，如此处所述: https://docs.microsoft.com/zh-CN/office/client-developer/access/desktop-database-reference/recordset-getrows-method-dao

This can retrieve the values from one or more named columns from the recordset into a variant array, as documented here: https://docs.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/recordset-getrows-method-dao

修改为使用 recordset.GetRows 的例程的版本可能是

A version of your routine modified to use recordset.GetRows might be

procedure ExportRecordsetToMSExcel(const DestName: string; Data: _Recordset);
var
  ovExcelApp: OleVariant;
  ovExcelWorkbook: OleVariant;
  ovWS: OleVariant;
  ovRange: OleVariant;
  Rows : Integer;
  FieldList : Variant;
  RSRows : OleVariant;
  i : Integer;
  Values : OleVariant;
begin
  ovExcelApp := CreateOleObject('Excel.Application');
  ovExcelApp.Visible := True; //  So we can see what's happening
  try
    ovExcelWorkbook := ovExcelApp.WorkBooks.Add;
    ovWS := ovExcelWorkbook.ActiveSheet;


    //  RecordSet.GetRows (see AdoIntf.Pas) can return one or more fields of the RS to a variant array
    FieldList := 'Name';
    RSRows := Data.GetRows(Data.RecordCount, '', 'name' );

    //  The values from the RS 'Name' field are now in the 2nd dimension of RSRows
    //  The following is a naive way of extracting these values to a Transposable array
    Values := VarArrayCreate([VarArrayLowBound(RSRows, 2), VarArrayHighBound(RSRows, 2)], varVariant);
    Rows := VarArrayHighBound(RSRows, 2) - VarArrayLowBound(RSRows, 2) + 1;

    for i := VarArrayLowBound(RSRows, 2) to VarArrayHighBound(RSRows, 2)  do begin
      Values[i] := RSRows[0, i];

      //  Note:  the next 2 lines are to avoid the known problem that calling Excel's Transpose
      //         will generate a "Type mismatch" error when the array bring transposed contains Nullss
      if VarIsNull(Values[i]) then
        Values[i] := '';
    end;

    //  Now, transpose Values into the destination range (the 'A' column) using Excel's built-in function
    ovWS.Range['A1:A' + IntToStr(Rows)] := ovExcelApp.Transpose(Values);

    ShowMessage(' here');
  finally
    ovExcelWorkbook.Close(SaveChanges := False); //  Abandon changes to avoid tedium in debugging
    ovWS := Unassigned;
    ovExcelWorkbook := Unassigned;

    ovExcelApp.Quit;
    ovExcelApp := Unassigned;
  end;
end;

如代码注释中所述，这将通过使用此答案提取我碰巧遇到的Sql表的 Name 列.

As noted in the code's comments, this extracts the Name column of the Sql table I happened to by using for this answer.

请注意R Hoek关于通过调用 DisableControls 和 EnableControls 将对绑定数据集的Open方法的调用括起来的评论，因为这可能会对速度产生重大影响作为将列导入Excel的方法.

Please note R Hoek's comment about bracketing the call to your bound dataset's Open method by calls to DisableControls and EnableControls, as this will likely have as big an impact on speed as the method you use to import the column(s) into Excel.

这篇关于如何使用Delphi(任何版本)仅将某些列从ADOQuery导出到Excel?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！