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;
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://docs.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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.