exceldelphitadoquery

How can I export only some columns from that ADOQuery to Excel using Delphi (any version)?


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);

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;

Solution

  • Update

    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.

    ====

    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;
    

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

    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;
    

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

    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.