类文件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
%>