asp中多个table表数据分别倒出到excel中 - 编程论坛

#2

yms1232013-02-18 12:16

http://www.
这篇文章推荐给lz，excel表格其实内部可以写作xml代码，这样可以用这种方法导出excel到多个sheet

#3

ysf01812013-02-19 15:44

<%
'语句放在要导出资料的末尾
Response.ContentType="application/vnd.ms-excel"
response.addheader "Content-Disposition", "attachment; filename=""学员资料"&year(now())&"年"&month(now())&"月"&day(now())&"日"&hour(now())&"时.xls"

%>

#4

ysf01812013-02-19 15:46

程序代码：

<%
  '/**************************/
  '/=====ASP的Excel生成类======/
  '/=======作者:yms123=========/
  '/====(编程论坛ASP版主)======/
  '/==编程论坛:bbs.bc-cn.net===/
  '/=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

#5

elongtown2013-02-24 10:37

这个好

#6

nicechlk2013-03-16 12:29

这样太猛了，奉献精神值得嘉奖！