asp中多个table表数据分别倒出到excel中
求高手帮忙 多个table表数据分别倒入不同的sheet表中 在线等 本人系asp菜鸟 如果有代码给发下 没有的给写的可以付烟钱 呵呵
2013-02-18 10:41
2013-02-18 12:16
2013-02-19 15:44
程序代码：<!--#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
2013-02-19 15:46
2013-02-24 10:37
2013-03-16 12:29