DataSet导出至Excel的控件

[Zoogreen]

请问谁有，将DataSet导至Excel的控件,(本人现在在维护一个老的程序，打印处我用到导至Excel的控件)，具体类有 TVExcelExport , TVExportDialog等，

[jinjazz]

代码就可以

[tw_cshn]

就用DBGRIDEH，里面有段代码可以直接导出数据到EXCEL,txt,html
网上很多地方可以下载

[Zoogreen]

这我知道，我导出过程也写过。可是就想用原来的控件，因为不太想改别人的老程序

[Zoogreen]

这个控件老早的了，不知道有没有朋友有啊？

[budded]

贴一个：我修改了别人东东！

unit DataSetToExcel;

interface

uses
SysUtils, Classes, ADODB, DB;

type
TDataSetToExcel = class(TComponent)
private
{ Private declarations }
FDataSet: TDataSet;
FADOConnect: TADOConnection;
FADOQuery: TADOQuery;
FADOTable: TADOTable;
procedure FSetDataSet(AValue: TDataSet);
procedure Finalize;
procedure Initialize;
protected
{ Protected declarations }
procedure Notification(AComponent: TComponent;Operation: TOperation);override;
public
{ Public declarations }
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
procedure SaveExcelToFile(AFileName: string;ASheetName: string='Sheet1');
published
{ Published declarations }
property DataSet: TDataSet read FDataSet write FSetDataSet;
end;

implementation

uses
ActiveX, ComObj, Variants, Forms, uCommon;

const
TEMP_TABLE_NAME = 't_temp';
TEMP_DB_FILE = 'temp.mdb';

adEmpty = $00000000;
adTinyInt = $00000010;
adSmallInt = $00000002;
adInteger = $00000003;
adBigInt = $00000014;
adUnsignedTinyInt = $00000011;
adUnsignedSmallInt = $00000012;
adUnsignedInt = $00000013;
adUnsignedBigInt = $00000015;
adSingle = $00000004;
adDouble = $00000005;
adCurrency = $00000006;
adDecimal = $0000000E;
adNumeric = $00000083;
adBoolean = $0000000B;
adError = $0000000A;
adUserDefined = $00000084;
adVariant = $0000000C;
adIDispatch = $00000009;
adIUnknown = $0000000D;
adGUID = $00000048;
adDate = $00000007;
adDBDate = $00000085;
adDBTime = $00000086;
adDBTimeStamp = $00000087;
adBSTR = $00000008;
adChar = $00000081;
adVarChar = $000000C8;
adLongVarChar = $000000C9;
adWChar = $00000082;
adVarWChar = $000000CA;
adLongVarWChar = $000000CB;
adBinary = $00000080;
adVarBinary = $000000CC;
adLongVarBinary = $000000CD;
adChapter = $00000088;
adFileTime = $00000040;
adPropVariant = $0000008A;
adVarNumeric = $0000008B;

function DBTypeToADOType(AValue: TFieldType): Integer;
begin
case AValue of
ftSmallint,
ftWord,
ftLargeint,
ftInteger: result := adInteger;
ftBoolean: result := adBoolean;
ftFloat: result := adSingle;
ftCurrency: result := adCurrency;
else
result := adVarWChar;
end;
end;

function GetTempFileName: string;
begin
Result := GetApplicationPath + TEMP_DB_FILE;
if FileExists(Result) then
DeleteFile(Result);
end;

constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Initialize;
end;

destructor TDataSetToExcel.Destroy;
begin
Finalize;
inherited;
end;

procedure TDataSetToExcel.Initialize;
begin
FADOConnect := TADOConnection.Create(Self);
FADOQuery := TADOQuery.Create(Self);
FADOTable := TADOTable.Create(Self);

FADOQuery.Connection := FADOConnect;
FADOTable.Connection := FADOConnect;
CoInitialize(nil);
end;
procedure TDataSetToExcel.Finalize;
begin
if Assigned(FADOQuery) then
FADOQuery.Free;
if Assigned(FADOTable) then
FADOTable.Free;
if Assigned(FADOConnect) then
FADOConnect.Free;
CoUninitialize;
GetTempFileName;
end;

procedure TDataSetToExcel.SaveExcelToFile(AFileName: string; ASheetName: string = 'Sheet1');
const
S_CONNECT_ACCESS = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source="%s"'; //Data Source中要有空格，""不能丢
S_CONNECT_EXCEL = 'Select * Into %s IN "%s" "Excel 8.0;" From t_temp';
var
LCatalog,LTable:OleVariant;
LConnStr:WideString;
i,ARecCount: integer;
LFileName: string;
begin
if (FDataSet = nil) or (FDataSet.FieldCount < 1) then
Exit;
ARecCount := FDataSet.FieldCount - 1;
if ARecCount <= 0 then
Exit;

LFileName := GetTempFileName;

LCatalog := CreateOleObject('ADOX.CATALOG');
LTable := CreateOleObject('ADOX.TABLE');

LConnStr := Format(S_CONNECT_ACCESS, [LFileName]);
FADOConnect.ConnectionString := LConnStr;

LCatalog.Create(LConnStr);
LTable.Name := TEMP_TABLE_NAME;
try
for i := 0 to ARecCount do
LTable.Columns.Append(FDataSet.FieldDefList.FieldDefs[i].Name,
DBTypeToADOType(FDataSet.FieldDefList.FieldDefs[i].DataType));
LCatalog.Tables.Append(LTable);

FADOTable.TableName := TEMP_TABLE_NAME;
FADOTable.Open;
FDataSet.First;
FADOTable.First;
repeat
FADOTable.Insert;
for i := 0 to ARecCount do
FADOTable.Fields[i].AsString := VarToStrDef(FDataSet.Fields[i].Value, '');
FDataSet.Next;
until FDataSet.Eof;

FADOTable.Post;

FADOQuery.Active := false;
FADOQuery.SQL.Clear;
FADOQuery.SQL.Add(Format(S_CONNECT_EXCEL, [ASheetName, AFileName]));
try
FADOQuery.ExecSQL;
except
raise;
end;
finally
LTable := UnAssigned;
LCatalog := UnAssigned;
FADOConnect.Connected := False;
end;
end;

procedure TDataSetToExcel.FSetDataSet(AValue: TDataSet);
begin
FDataSet := AValue;
if FDataSet <> nil then
FDataSet.FreeNotification(self);
end;

procedure TDataSetToExcel.Notification(AComponent: TComponent;Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = DataSet) then
DataSet := nil;
end;

end.