我在Delphi中有一个带有多列(字段)的ADOQuery (TADOQuery,绑定到其他可视组件)。我可以将所有数据(行和列)导出到Excel文件中。我使用的是OleVariant,类似于ovRange.CopyFromRecordset (数据、行、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;
发布于 2021-03-14 13:14:43
更新
我有义务让Peter建议使用Excel的Transpose
函数,以避免在我的初始代码中逐元素复制元素。在尝试实现它时,我发现Transpose
遇到了一个已知的问题,如果它在正在转换的数组中遇到一个空值,它会抛出一个“类型不匹配”错误。下面更新的代码解决了这个问题,并且从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
列。
请注意Excel关于通过调用DisableControls
和EnableControls
来将对绑定dataset的Open方法的调用括起来的评论,因为这可能对速度的影响与将列导入Excel的方法一样大。
https://stackoverflow.com/questions/66619715
复制相似问题