类文件Excel.asp

<%
'/**************************************/
'/* written by yzcangel                */
'/* version : v1.0                     */
'/* createdata:2005-09-01                   */
'/* lastmodifydate:2005-09-01          */
'/* Eamil:yzcangel@sohu.com            */
'/* QQ:80214600                        */
'/**************************************/
'类开始
Class Cls_Excel
     '声明常量、变量
     Private objRs
     Private objExcelApp
     Private objExcelBook
     Private Conn
     Private Sql
     Private Title
     Private FieldName
     Private FieldValue
     Private FilePath
     Private FileName
     Private Col
     Private Row
     'Class_Initialize 类的初始化
     Private Sub Class_Initialize()
           Row = 1 '设定生成的Excel默认起始行
           Col = 1 '设定生成的Excel默认起始列
     End Sub
     'ReportConn得到数据库连接对象
     Public Property Let ReportConn(ByVal objConn)
           Set Conn = objConn
     End Property
     'ReportSql得到SQL字符串
     Public Property Let ReportSql(ByVal strSql)  
           Sql = strSql
     End Property
     'ReportTitle得到所要生成报表的标题
     Public Property Let ReportTitle(ByVal strTitle)  
           Title = strTitle
     End Property
     'RsFieldName得到所要生成报表的列名称
     Public Property Let RsFieldName(ByVal strName)  
           FieldName = Split(strName,"||")
     End Property
     'RsFieldValue得到所要生成报表的列值的数据库标识字段
     Public Property Let RsFieldValue(ByVal strValue)  
           FieldValue = Split(strValue,"||")
     End Property
     'SaveFilePath得到Excel报表的保存路径
     Public Property Let SaveFilePath(ByVal strFilePath)  
           FilePath = strFilePath
     End Property
     'SaveFileName得到Excel报表的保存文件名
     Public Property Let SaveFileName(ByVal strFileName)  
           FileName = strFileName
     End Property
     'ColumnOffset得到Excel报表默认起始列
     Public Property Let ColumnOffset(ByVal ColOff)
           If ColOff > 0 then
                 Col = ColOff
           Else
                 Col = 1
           End If
     End Property
     'RowOffset得到Excel报表默认起始行
     Public Property Let RowOffset(ByVal RowOff)
           If RowOff > 0 then
                 Row = RowOff
           Else
                 Row = 1
           End If
     End Property
     '生成报表
     Sub Worksheet()
           Dim iCol,iRow,Num
           iCol = Col
           iRow = Row
           Num = 1
           Call DBRs()
           Call ExcelApp()
           Set objExcelBook = objExcelApp.Workbooks.Add
           '写Excel标题
           '--------------------------------------------------------
           objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = Title
           '--------------------------------------------------------
           '写Excel各列名
           '--------------------------------------------------------
           iRow = Row + 1
           objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = "序号"
           iCol = iCol + 1
           For i = 0 to Ubound(FieldName)
                 objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = FieldName(i)
                 iCol = iCol + 1
           Next
           '--------------------------------------------------------
           '写Excel各列值
           '--------------------------------------------------------
           iRow = Row + 2
           Do While Not objRS.EOF
                 iCol = Col
                 objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = Num
                 iCol = iCol + 1
                 For i = 0 to Ubound(FieldValue)
                       If IsNull(objRS(FieldValue(i))) then
                             objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = ""
                       Else
                             objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = objRS(FieldValue(i))
                       End If
                       iCol = iCol + 1
                 Next
                 objRS.MoveNext
                 iRow = iRow + 1
                 Num = Num + 1
           Loop
           '--------------------------------------------------------
           Call SaveWorksheet()
     End Sub
     '创建Adodb.Recordset对象
     Sub DBRs()
           If IsObject(objRs) = True Then Exit Sub
           Set objRs = Server.CreateObject("Adodb.Recordset")
           objRs.Open Sql,Conn,1,1
           If Err.Number > 0 Then
                 Response.End
           End If
     End Sub
     '创建Excel.Application对象
     Sub ExcelApp()
           If IsObject(objExcelApp) = True Then Exit Sub
           Set objExcelApp = Server.CreateObject("Excel.Application")
           objExcelApp.Application.Visible = True
           If Err.Number > 0 Then
                 Response.End
           End If
     End Sub
     '保存Excel报表
     Sub SaveWorksheet()
           objExcelbook.SaveAs FilePath & FileName & ".xls"
           If Err.Number = 0 Then
                 Call Message("导出数据成功！")
           Else
                 Call Message("导出数据失败！")
           End If
     End Sub
     '信息提示
     Sub Message(msg)
           Response.Write("<script language='JavaScript'>")
           Response.Write("alert('"&msg&"');")
           Response.Write("</script>")
           Response.End
     End Sub
     'Class_Terminate 类注销
     Private Sub Class_Terminate()
           objExcelApp.Application.Quit
           Set objExcelBook = Nothing
           Set objExcelApp = Nothing
           objRs.Close
           Set objRs = Nothing
     End Sub
'类结束
End Class
%>

示例文件test.asp

<!--#include file="Lib/conn.asp"-->
<!--#include file="Excel.asp"-->
<%
Dim MyExcel
Set MyExcel = new Cls_Excel
With MyExcel
     .ReportConn = conn
     .ReportSql = "SELECT b.pm AS A_PM, b.dqccl AS A_Num, b.dqccl * 100 / SUM(a.dqccl) AS A_Percent FROM dbo.V_DQTJWHP a CROSS JOIN dbo.V_DQTJWHP b GROUP BY b.pm, b.dqccl order by A_Num desc"
     .ReportTitle = "MyExcel 报表"
     .RsFieldName = "品名||数量||百分比"
     .RsFieldValue = "A_PM||A_Num||A_Percent"
     .SaveFilePath = "d:\"
     .SaveFileName = "Excel"
     .ColumnOffset = 1
     .RowOffset = 1
End With
MyExcel.Worksheet()
MyExcel = Null
Set MyExcel = Nothing
%>