To export a class of Excel reports

class file Excel.asp

<%
''/**************************************/
"* * Written by Yzcangel * *
"* * version:v1.0 * *
"* * createdata:2005-09-01 * *
"* * lastmodifydate:2005-09-01 * *
"* * eamil:yzcangel@sohu.com * *
"* * qq:80214600 * *
''/**************************************/
' Class begins
Class Cls_excel
' Declare constants, variables
Private objRS
Private Objexcelapp
Private Objexcelbook
Private Conn
Private SQL
Private Title
Private FieldName
Private Fieldvalue
Private FilePath
Private FileName
Private Col
Private Row
"Initialization of the Class_Initialize class
Private Sub Class_Initialize ()
row = 1 ' Sets the default start line for the generated Excel
Col = 1 ' Sets the generated Excel default start column
End Sub
"Reportconn Gets the database connection object
Public Property Let Reportconn (ByVal objconn)
Set Conn = objconn
End Property
"Reportsql gets the SQL string
Public Property Let Reportsql (ByVal strSQL)
SQL = strSQL
End Property
"Reporttitle get the title of the report you want to generate
Public Property Let Reporttitle (ByVal strtitle)
Title = Strtitle
End Property
' Rsfieldname get the column name of the report you want to generate
Public Property Let Rsfieldname (ByVal strName)
FieldName = Split (StrName, "")
End Property
' Rsfieldvalue the Database identification field for the column value of the report you want to generate
Public Property Let Rsfieldvalue (ByVal strvalue)
Fieldvalue = Split (strvalue, "")
End Property
' Savefilepath get Excel Report save path
Public Property Let Savefilepath (ByVal strFilePath)
FilePath = strFilePath
End Property
"Savefilename Gets the saved file name of the Excel report
Public Property Let Savefilename (ByVal strFileName)
FileName = strFileName
End Property
' ColumnOffset get Excel report default start column
Public Property Let ColumnOffset (ByVal Coloff)
If Coloff > 0 Then
Col = Coloff
Else
Col = 1
End If
End Property
' RowOffset get Excel report default start line
Public Property Let RowOffset (ByVal Rowoff)
If Rowoff > 0 Then
Row = Rowoff
Else
Row = 1
End If
End Property
' Generate a report
SUB worksheet ()
Dim Icol,irow,num
Icol = Col
IRow = Row
Num = 1
Call DBRs ()
Call Excelapp ()
Set Objexcelbook = ObjExcelApp.Workbooks.Add
"Write Excel Title
''--------------------------------------------------------
Objexcelbook.worksheets (1). Cells (Irow,icol). Value = Title
''--------------------------------------------------------
"Write Excel column names
''--------------------------------------------------------
IRow = Row + 1
Objexcelbook.worksheets (1). Cells (Irow,icol). Value = "ordinal"
Icol = Icol + 1
For i = 0 to Ubound (FieldName)
Objexcelbook.worksheets (1). Cells (Irow,icol). Value = FieldName (i)
Icol = Icol + 1
Next
''--------------------------------------------------------
"Write Excel column values
''--------------------------------------------------------
IRow = Row + 2
Do as 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
' Create Adodb.recordset Object
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
' Create Excel.Application Object
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
' Save Excel Report
Sub Saveworksheet ()
Objexcelbook.saveas FilePath & FileName & ". xls"
If Err.Number = 0 Then
Call message ("Export data successful!") ")
Else
Call message ("Export data failed!") ")
End If
End Sub
"Information tips
Sub Message (MSG)
Response.Write ("<script language= ' JavaScript ' >")
Response.Write ("Alert (' &msg&"); ")
Response.Write ("</script>")
Response.End
End Sub
' Class_Terminate class logoff
Private Sub Class_Terminate ()
ObjExcelApp.Application.Quit
Set Objexcelbook = Nothing
Set Objexcelapp = Nothing
Objrs.close
Set objRS = Nothing
End Sub
"End of Class"
End Class
%>