excel - 如何使用 Delphi(任何版本)仅将 ADOQuery 中的某些列导出到 Excel？

Question

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

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 的回答的工作解决方案):

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;

Answer 1

更新

我不得不向 Peter Wolf 提出使用 Excel 的 Transpose 函数的建议，以避免在我的初始代码中逐个元素地进行复制。在尝试实现它时，我发现我遇到了一个关于 Transpose 的已知问题，如果它在转置的数组中遇到 Null，它会抛出“类型不匹配”错误。下面更新的代码解决了这个问题，并且还从 OP 的代码中删除了一些在我看来是多余的行。

====

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

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

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

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

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 列。

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