2

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;
5
  • Why not simply querying the database with a statement returning only the required fields? Commented Mar 14, 2021 at 7:39
  • The ADOQuery is bound to a visual control that shows multiple fields, and what I want is to export a set of these columns (whichever is specified). Also, the original query has many records, so it is not feasible to do it row by row. I have also tried using ADOQuery2.Clone (ADOQuery), but I have not been able to achieve it. Commented Mar 14, 2021 at 7:47
  • Forget the Excel sheet for a moment. Are you able to write all rows and columns with the fields you are interested in into a simple two dimensions array? Commented Mar 14, 2021 at 7:59
  • I can write the fields that interest me in a two-dimensional array, for example: ArrData:= VarArrayCreate(...);, and write the values. With that solution I can then directly write the array (Range.Value: = ArrayData). The disadvantage of this solution is that ADOQuery has many records, and the process would be very slow. Commented Mar 14, 2021 at 8:12
  • Use DisableControls on the TDatset when traversing the records, this will speed it up as the controls your dataset is connected to, are not updated on each row move. Commented Mar 14, 2021 at 12:27

2 Answers 2

2

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.

Sign up to request clarification or add additional context in comments.

11 Comments

+1 for suggesting GetRows. However copying rows one by one from the resulting array will be slow. Why not to write the whole array at once? Target range is ovRange := ovWS.Range[ovWS.Cells[1, 1], ovWS.Cells[VarArrayHighBound(RSRows, 2) - VarArrayLowBound(RSRows, 2) + 1, VarArrayHighBound(RSRows, 1) - VarArrayLowBound(RSRows, 1) + 1]];. Now you can assign the array to Value2 of the range, but it will probably need transposing rows to columns: ovRange.Value2 := ovExcelApp.WorksheetFunction.Transpose(RSRows);.
I don't think DisableControls / EnableControls is really needed, because GetRows will not change active record of the dataset.
"Why not to write the whole array at once?" Because the row values are in the 2nd column returned by GetRows, assigning the array in one go just doesn't work (otherwise I wold have done it). IAC, the for loop executes virtually instantaneously using my test data (~5k rows).
"I don't think DisableControls / EnableControls is really needed" It's not for speeding up GetRows, but rather for the call to the recordset's owner's Open.
Note the use of Transpose function in my comment to match the shape of the target range. Besides that you only copy single column while the question indicates copying multiple columns. I did a quick test with 5K rows with single column and copying of individual values was ~10 times slower compared to writing the values to range in one step. The key to speed is to minimize calls to methods of automation object.
|
0

You can set or change the definition of a query , for example AdoQouery2 ,as below:

if AdoQouery2.active then
 AdoQouery2.close ;
AdoQouery2.sql.clear ;
AdoQouery2.sql.add ( 'Select filed1 , filed2 ,... from table1') ;
AdoQouery2.open ;

1 Comment

Your answer could be improved with additional supporting information. Please edit to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers in the help center.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.