将dataset中的数据导出至Excel中而不需要安装MS Excel的方法（含UNICODE支持）

偶尔做界面程序，需要一个导出Excel，而在客户端又不用安装MS Excel的方法，总结如下。

测试了两种方法，第一种方法如下（此方法支持UNICODE不存在问题）：

参考：http://www.swissdelphicenter.ch/torry/showcode.php?id=1427

procedure DBGridToExcelADO(Query: TDataSet; FileName: string; SheetName: string);
varcat: _Catalog;tbl: _Table;col: _Column;i: integer;ADOConnection: TADOConnection;ADOQuery: TADOQuery;
beginif FileExists(FileName) then  // It's better to delete the file first, or there may be a "external table is not in the expected format" error. by genispanDeleteFile(FileName);//WorkBook creation (database)cat := CoCatalog.Create;//cat._Set_ActiveConnectioncat.Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0');//WorkSheet creation (table)tbl := CoTable.Create;tbl.Set_Name(SheetName);//Columns creation (fields)Query.First;with Query.Fields dobeginfor i := 0 to Count - 1 dobegincol := nil;col := CoColumn.Create;with col dobeginSet_Name(Query.Fields[i].FieldName);Set_Type_(adVarWChar);end;//add column to tabletbl.Columns.Append(col, adVarWChar, 20);end;end;//add table to databasecat.Tables.Append(tbl);col := nil;tbl := nil;cat := nil;ADOConnection := TADOConnection.Create(nil);ADOConnection.LoginPrompt := False;ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0';ADOQuery := TADOQuery.Create(nil);ADOQuery.Connection := ADOConnection;ADOQuery.SQL.Text := 'Select * from [' + SheetName + '$]';ADOQuery.Open;trywith Query dobeginFirst;while not Eof dobeginADOQuery.Append;with Query.Fields dobeginADOQuery.Edit;for i := 0 to Count - 1 doADOQuery.FieldByName(Query.Fields[i].FieldName).AsString := FieldByName(Query.Fields[i].FieldName).AsString;ADOQuery.Post;end;Next;end;end;finallyADOQuery.Close;ADOConnection.Close;ADOQuery.Free;ADOConnection.Free;end;
end;

第二种方法，此方法效率更高，但导出UNICODE字符串存在问题，如有高手看到可留言帮助解决下，以下为整理好了的pas单元源码：

unit uExcel;interfaceUsesDB, Classes, Dialogs,DBGrids,Controls;
varCXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);//OPCode, size, codepageCXlsCodePage: array[0..2] of Word = ($0042, $0002, $04B0);CXlsEof: array[0..1] of Word = ($0A, 00);CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);Type
TDS2Excel = Class(TObject)
PrivateFCol: word;FRow: word;FDataSet: TDataSet;FDbGrid  :TDbGrid;Stream: TStream;FWillWriteHead: boolean;FBookMark: TBookmark;procedure IncColRow;procedure WriteBlankCell;procedure WriteFloatCell(const AValue: Double);procedure WriteIntegerCell(const AValue: Integer);procedure WriteStringCell(const AValue: string);procedure WritePrefix;procedure WriteSuffix;procedure WriteTitle;procedure WriteDataCell;procedure Save2Stream(aStream: TStream);
Publicprocedure Save2File(FileName: string; WillWriteHead: Boolean);procedure Save2Files(WillWriteHead: Boolean);Constructor Create(aDataSet: TDataSet;aDBGrid:TDBGrid);
end;implementationuses SysUtils;Constructor TDS2Excel.Create(aDataSet: TDataSet;aDBGrid:TDBGrid);
begininherited Create;FDataSet := aDataSet;FDbGrid  :=aDbGrid;
end;procedure TDS2Excel.IncColRow;
begin
if FDbGrid <>nil then
beginif FCol = FDbGrid.Columns.Count - 1 thenbeginInc(FRow);FCol :=0;endelseInc(FCol);
end else
beginif FCol = FDataSet.FieldCount - 1 thenbeginInc(FRow);FCol :=0;endelseInc(FCol);
end;
end;procedure TDS2Excel.WriteBlankCell;
beginCXlsBlank[2] := FRow;CXlsBlank[3] := FCol;Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));IncColRow;
end;procedure TDS2Excel.WriteFloatCell(const AValue: Double);
beginCXlsNumber[2] := FRow;CXlsNumber[3] := FCol;Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));Stream.WriteBuffer(AValue, 8);IncColRow;
end;procedure TDS2Excel.WriteIntegerCell(const AValue: Integer);
varV: Integer;
beginCXlsRk[2] := FRow;CXlsRk[3] := FCol;Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));V := (AValue shl 2) or 2;Stream.WriteBuffer(V, 4);IncColRow;
end;procedure TDS2Excel.WriteStringCell(const AValue: string);
varL: Word;_str : AnsiString;
begin
    _str := AnsiString(AValue);  // in delphi XE, there will be error for unicode, fix me !!!!!!!!!!!  --by genispanL := Length(_str);CXlsLabel[1] := 8 + L;CXlsLabel[2] := FRow;CXlsLabel[3] := FCol;CXlsLabel[5] := L;Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));Stream.WriteBuffer(Pointer(_str)^, L);IncColRow;
end;procedure TDS2Excel.WritePrefix;
beginStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));Stream.WriteBuffer(cxlscodepage, SizeOf(cxlscodepage));
end;procedure TDS2Excel.WriteSuffix;
beginStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;procedure TDS2Excel.WriteTitle;
varn: word;
beginif FDbGrid <> nil thenfor n := 0 to FDBGrid.Columns.Count - 1 doWriteStringCell(FDBGrid.Columns[n].Title.Caption)elsefor n := 0 to FDataSet.FieldCount - 1 doWriteStringCell(FDataSet.Fields[n].FieldName);
end;procedure TDS2Excel.WriteDataCell;
varn: word;
beginWritePrefix;if FWillWriteHead then WriteTitle;FDataSet.DisableControls;FBookMark := FDataSet.GetBookmark;FDataSet.First;if FDbGrid=nil thenbeginwhile not FDataSet.Eof dobeginfor n := 0 to FDataSet.FieldCount - 1 dobegintryif FDataSet.Fields[n].IsNull thenWriteBlankCellelse begincase FDataSet.Fields[n].DataType offtSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:WriteIntegerCell(FDataSet.Fields[n].AsInteger);ftFloat, ftCurrency, ftBCD:WriteFloatCell(FDataSet.Fields[n].AsFloat);ftTypedBinary:elseWriteStringCell(FDataSet.Fields[n].AsString);end;end;exceptWriteBlankCell;end;end;FDataSet.Next;end;endelsebeginwhile not FDbGrid.DataSource.DataSet.Eof dobeginfor n := 0 to FDbGrid.Columns.Count - 1 dobeginif FDbGrid.Columns[n].Field.IsNull thenWriteBlankCellelse begincase FDbGrid.Columns[n].Field.DataType offtSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:WriteIntegerCell(FDbGrid.Columns[n].Field.AsInteger);ftFloat, ftCurrency, ftBCD:WriteFloatCell(FDbGrid.Columns[n].Field.AsFloat);elseWriteStringCell(FDbGrid.Columns[n].Field.AsString);end;end;end;FDbGrid.DataSource.DataSet.Nextend;end;WriteSuffix;if FDataSet.BookmarkValid(FBookMark) then FDataSet.GotoBookmark(FBookMark);FDataSet.EnableControls;
end;procedure TDS2Excel.Save2Stream(aStream: TStream);
beginFCol := 0;FRow := 0;Stream := aStream;WriteDataCell;
end;procedure TDS2Excel.Save2File(FileName: string; WillWriteHead: Boolean);
varaFileStream: TFileStream;
beginFWillWriteHead := WillWriteHead;if FileExists(FileName) then DeleteFile(FileName);aFileStream := TFileStream.Create(FileName, fmCreate);TrySave2Stream(aFileStream);FinallyaFileStream.Free;end;
end;procedure TDS2Excel.Save2FileS(WillWriteHead: Boolean);
varSaveDialog11: TSaveDialog;
beginSaveDialog11 := TSaveDialog.Create(nil);TrySaveDialog11.Filter := 'Excel|*.xls';SaveDialog11.InitialDir := 'C:\';SaveDialog11.FileName:='*.xls';if not SaveDialog11.Execute then exit;if FileExists(SaveDialog11.FileName) then DeleteFile(SaveDialog11.FileName);Save2File(SaveDialog11.FileName, WillWriteHead);FinallySaveDialog11.Free;end;
end;end.

将dataset中的数据导出至Excel中而不需要安装MS Excel的方法（含UNICODE支持）相关推荐

如何将表中的数据导出到电子表格中
如何将表中的数据导出到电子表格中有很多方法都可将数据库中某个表的数据导出到电子表格中,例如通过创建Access.Application,可以利用Access本 ...
matlab将求解值导出数据,MATLAB之将mat中的数据导出到Excel文件
MATLAB之将mat中的数据导出到Excel文件原始文档: https://www.yuque.com/lart/tools/cnedve 文章目录 MATLAB之将mat中的数据导出到Excel ...
如何将存储在MongoDB数据库中的数据导出到Excel中？
将MongoDB数据库中的数据导出到Excel中,只需以下几个步骤: (1)首先,打开MongoDB安装目录下的bin文件夹,(C:\Program Files (x86)\MongoDB\Serve ...
DataTable中的数据导出Excel文件
DataTable中的数据导出Excel文件 View Code ///<summary> /// 将DataTable中的数据导出到指定的Excel文件中 ///</summary ...
在vue中把数据导出Excel文件
在vue中把数据导出Excel文件第一次尝试写文章在vue中把数据导出成Excel格式的文件,话不多,上代码: 第一步我们要先安装几个集成的插件 npm install -S file-saver ...
vb 读取oracle中的表格数据,如何将数据库信息读取导出excel表格中-VB 从SQL数据库中把数据导出到Excel表格中，怎么写？...
VB 从SQL数据库中把数据导出到Excel表格中,怎么写? INSERT INTO OpenDataSource('Microsoft.Jet.OLEDB.4.0', 'Data Source=&q ...
lisp倒入excel数据画图_如何将EXCEL中的数据导入到CAD中，绘制成曲线|
如何将EXCEL中的数据导入到CAD中,绘制成曲线如果不用软件,只用CAD自身功能的话可以通过多段线生成你需要的曲线.你给出你的曲线函数,我给你生成曲线坐标以及CAD能自动绘制的文件格式怎样将ca ...
Laravel 将数据表中的数据导出，并生成seed文件
在 laravel 开发过程中,我们为了将自己本地数据库中的数据导出给别人用有两种方法:最普通的也就是将自己的数据库用命令行或者图形操作工具导出成 .sql 的文件给对方使用 ,另外一种就是 lara ...
python亿级mysql数据库导出_Python实现将MySQL数据库表中的数据导出生成csv格式文件的方法...
本文实例讲述了python实现将MySQL数据库表中的数据导出生成csv格式文件的方法.分享给大家供大家参考,具体如下: #!/usr/bin/env python # -*- coding:utf- ...

将dataset中的数据导出至Excel中而不需要安装MS Excel的方法（含UNICODE支持）

将dataset中的数据导出至Excel中而不需要安装MS Excel的方法（含UNICODE支持）相关推荐

最新文章

热门文章