asp中多个table表数据分别倒出到excel中
求高手帮忙 多个table表数据分别倒入不同的sheet表中 在线等 本人系asp菜鸟 如果有代码给发下 没有的给写的可以付烟钱 呵呵
http://www.
这篇文章推荐给lz,excel表格其实内部可以写作xml代码,这样可以用这种方法导出excel到多个sheet
<!--#include file="adovbs.inc"--> <% '/**************************/ '/=====ASP的Excel生成类======/ '/=======作者:yms123=========/ '/====(编程论坛ASP版主)======/ '/==编程论坛:bbs. '/=E-Mail:yms126@vip. '/==MSN:yms126@ '/=复制代码请勿删除版权信息==/ Class ExcelMarker '--------' '公开属性' '''''''''' Private mFileName'Excel文件路径和文件名 Private mSheetName'Excel工作表名称 Private mTableName'数据库的表名称 Private mConStr'Excel连接字符串 '--------' '内部属性' '''''''''' Private ObjExcel'Excel对象 Private ObjSheet'工作表对象 Private ObjFso'FSO对象 Private ExlHtml'Excel的HTML对象 Private i,r,c'循环变量 Private ExlCon'Excel连接对象 Private ExlRs'Excel记录集对象 Private AdoStream'ADODB.Stream对象 '----------------' 'Excel类属性初始化' '''''''''''''''''' Private Sub Class_Initialize mFileName="" mSheetName="" mTableName="" ExlHtml="" '初始化连接字符串 mConStr="Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source={FileName};Extended Properties='Excel 8.0;IMEX=1;HDR=NO';" End Sub '--------' '内部方法' '''''''''' Private Function GetExcelSqlField(ObjRs) Dim FSql FSql="" For i=0 To ObjRs.Fields.Count-1 FSql=FSql&ObjRs.Fields(i).Name FSql=FSql&" char("&Len(CStr(ObjRs.Fields(i).Value))&")," Next FSql=Mid(FSql,1,Len(FSql)-1) GetExcelSqlField=FSql End Function '--------' '内部过程 ''''''''' '创建FSO对象 Private Sub CreateFileSystemObject() Set ObjFso=Server.CreateObject("Scripting.FileSystemObject") Set ObjExcel=ObjFso.CreateTextFile(mFileName) End Sub '创建Excel对象 Private Sub CreateExcelApplication() Set ObjExcel=Server.CreateObject("Excel.Application") ObjExcel.DisplayAlerts = False'不显示警告窗口 ObjExcel.Application.Visible=False'不可见 ObjExcel.Workbooks.Add Set ObjSheet=ObjExcel.Worksheets(1) End Sub '创建ADODB.Stream对象 Private Sub CreateADODBStream() Set AdoStream=Server.CreateObject("ADODB.Stream") AdoStream.Type=2 AdoStream.Open End Sub 'ADODB.Stream对象保存文件方法 Private Sub SaveADODBStream() AdoStream.SaveToFile mFileName,2 End Sub '创建ADODB对象 Private Sub CreateADODBObject() Set ExlCon=Server.CreateObject("ADODB.Connection") Set ExlRs=Server.CreateObject("ADODB.RecordSet") ExlCon.Open Replace(mConStr,"{FileName}",mFileName) End Sub '创建Excel工作表(ADODB) Private Sub CreateADODBTable(ObjRs) Dim ExlSql ExlSql="Create table ["&mFileName&"]" ExlSql=ExlSql&"."&mSheetName ExlSql=ExlSql&" ("&GetExcelSqlField(ObjRs)&")" ExlCon.Execute ExlSql End Sub '填充数据到Excel工作表(ADODB) Private Sub FillADODBExcel(ObjRs) ExlRs.Open "select * from ["&mSheetName&"$]" ,ExlCon,adOpenDynamic,adLockOptimistic Do Until ObjRs.EOF ExlRs.AddNew For i=0 To ObjRs.Fields.Count-1 ExlRs.Fields(i).Value=ObjRs.Fields(i).Value Next ExlRs.Update ObjRs.MoveNext Loop End Sub '填充Excel工作表头部信息 Private Sub FillExcelHead(ObjRs) For i=0 To ObjRs.Fields.Count-1 ObjSheet.Cells(1,i+1).Value=ObjRs.Fields(i).Name Next End Sub '填充数据到Excel工作表 Private Sub FillExcelSheet(ObjRs) r=2 Do Until ObjRs.EOF For c=0 To ObjRs.Fields.Count-1 ObjSheet.Cells(r,c+1).Value=ObjRs.Fields(c).Value Next r=r+1 ObjRs.MoveNext Loop End Sub '保存Excel文件 Private Sub SaveExcelFile() ObjSheet.SaveAs mFileName End Sub '生成Excel的HTML表格头部代码 Private Sub MarkHtmlTBHead(ObjRs) ExlHtml="<table>"&Chr(13) ExlHtml=ExlHtml&"<tr>"&Chr(13) For i=0 To ObjRs.Fields.Count-1 ExlHtml=ExlHtml&"<td>"&ObjRs.Fields(i).Name&"</td>"&Chr(13) Next ExlHtml=ExlHtml&"</tr>"&Chr(13) End Sub '生成Excel的HTML表格内容代码 Private Sub MarhHtmlTBBody(ObjRs) Do Until ObjRs.EOF ExlHtml=ExlHtml&"<tr>"&Chr(13) For i=0 To ObjRs.Fields.Count-1 ExlHtml=ExlHtml&"<td>"&ObjRs.Fields(i).Value&"</td>"&Chr(13) Next ExlHtml=ExlHtml&"</tr>"&Chr(13) ObjRs.MoveNext Loop ExlHtml=ExlHtml&"</Table>" End Sub '释放对象方法 Private Sub FreeObject(Obj) Set Obj=Nothing End Sub '--------' '公开过程' '--------' 'FSO方式生成Excel文件 '参数:数据库记录集对象 Public Sub FSOMarkExcel(ObjRs) CreateFileSystemObject MarkHtmlTBHead ObjRs MarhHtmlTBBody ObjRs ObjExcel.Write ExlHtml ObjExcel.Close FreeObject ObjExcel FreeObject ObjFso End Sub 'Excel程序方式生成Excel文件 '参数:数据库记录集对象 Public Sub ExcelApplication(ObjRs) CreateExcelApplication FillExcelHead ObjRs FillExcelSheet ObjRs SaveExcelFile ObjExcel.Quit FreeObject ObjExcel FreeObject ObjSheet End Sub 'ADO方式生成Excel文件 Public Sub ADOMarkExcel(ObjRs) CreateADODBObject CreateADODBTable ObjRs FillADODBExcel ObjRs ExlCon.Close ExlRs.Close FreeObject ExlCon FreeObject ExlRs End Sub 'ADOStream方法生成Excel文件 Public Sub ADOStreamExcel(ObjRs) CreateADODBStream MarkHtmlTBHead ObjRs MarhHtmlTBBody ObjRs AdoStream.WriteText ExlHtml SaveADODBStream AdoStream.Close FreeObject AdoStream End Sub '创建空Excel文件过程 Public Sub EmptyExcelFile(CreateMode,ObjRs) Select Case CreateMode Case "ADODB.Stream" CreateADODBStream MarkHtmlTBHead ObjRs AdoStream.WriteText ExlHtml&"</table>" SaveADODBStream AdoStream.Close FreeObject AdoStream Case "FileObjectSystem" CreateFileSystemObject MarkHtmlTBHead ObjRs ObjExcel.Write ExlHtml&"</table>" ObjExcel.Close FreeObject ObjExcel FreeObject ObjFso End Select End Sub '--------' '公开方法' '''''''''' '返回Excel的HTML代码 Public Function getExcelHtml(ObjRs) MarkHtmlTBHead ObjRs MarhHtmlTBBody ObjRs getExcelHtml=ExlHtml End Function '--------' '属性过程' ''''''''' 'Public Property Let ConnectionString(vData) 'mConStr=vData 'End Property 'Public Property Get ConnectionString(vData) 'ConnectionString=mConStr 'End Property Public Property Let TableName(vData) mTableName=vData End Property Public Property Get TableName() TableName=mTableName End Property Public Property Let SheetName(vData) mSheetName=vData End Property Public Property Get SheetName() SheetName=mSheetName End Property Public Property Let FileName(vData) mFileName=vData End Property Public Property Get FileName() FileName=mFileName End Property End Class %>ExcelControl.asp