[英]How can I export only some columns from that ADOQuery to Excel using Delphi (any version)?
我在 Delphi 中有一个带有多个列(字段)的 ADOQuery(TADOQuery,绑定到其他可视组件)。 我可以将所有数据(行和列)导出到 Excel 文件。 我正在使用 OleVariant,类似于 ovRange.CopyFromRecordset (Data, Rows, Cols)。 如何使用 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;
更新
我有义务向 Peter Wolf 提出使用 Excel 的Transpose
function 的建议,以避免在我的初始代码中逐个元素地复制元素。 尝试实现它时,我发现我遇到了Transpose
的一个已知问题,如果它在它正在转置的数组中遇到 Null ,它会引发“类型不匹配”错误。 下面更新的代码解决了这个问题,并且还从 OP 的代码中删除了一些在我看来是多余的行。
====
您可以按照您的要求进行操作,而无需更改用于检索记录集的 SQL,方法是使用在 AdoIntf.Pas 中声明为的记录集的GetRows
方法
function GetRows(Rows: Integer; Start: OleVariant; Fields: OleVariant): OleVariant; safecall;
这可以将记录集中一个或多个命名列的值检索到一个变体数组中,如下所述: https://docs.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
对绑定数据集的 Open 方法的调用括起来的评论,因为这对速度的影响可能与您用于将列导入 Excel 的方法一样大。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.