asp excel导出类

关注

转载最新推荐文章于 2026-04-28 07:00:49 发布 2.1k 阅读 AI 写同款· GEO 优化 ›

导出Excel报表的类asp学习网 来自:leadbbs 作者：一千零一个愿望 
类文件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 = "序号" 
iColiCol = iCol + 1 
For i = 0 to Ubound(FieldName) 
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = FieldName(i) 
iColiCol = iCol + 1 
Next 
''-------------------------------------------------------- 
''写Excel各列值 
''-------------------------------------------------------- 
iRow = Row + 2 
Do While Not objRS.EOF 
iCol = Col 
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = Num 
iColiCol = 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 
iColiCol = iCol + 1 
Next 
objRS.MoveNext 
iRowiRow = iRow + 1 
NumNum = 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 
%>