我是在网上找到一个将数据存到Excel表格中的类,然后经过自己修改使用的。
我把这个类存成Excel.inc文件。
Excel.inc
<%
Class ExcelGen
Private objSpreadsheet
Private iColOffset
Private iRowOffset
Sub Class_Initialize()
Set objSpreadsheet = Server.CreateObject("OWC.Spreadsheet")
iRowOffset = 2
iColOffset = 2
End Sub
Sub Class_Terminate()
Set objSpreadsheet = Nothing 'Clean up
End Sub
Public Property Let ColumnOffset(iColOff)
If iColOff > 0 then
iColOffset = iColOff
Else
iColOffset = 2
End If
End Property
Public Property Let RowOffset(iRowOff)
If iRowOff > 0 then
iRowOffset = iRowOff
Else
iRowOffset = 2
End If
End Property
Sub GenerateWorksheet(objRS,val)
'Populates the Excel worksheet based on a Recordset's contents
'Start by displaying the titles
Dim s_Str
If val = 1 Then
s_Str = "VIP模式(无延时)"
Else
s_Str = "普通模式(有延时)"
End If
If objRS.EOF then Exit Sub
Dim objField, iCol, iRow
iCol = iColOffset
iRow = iRowOffset
objSpreadsheet.Range("A1:M1").Select
objSpreadsheet.Selection.Merge
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol).Font.Size = 12
objSpreadsheet.Cells(iRow, iCol).Halignment = 2
objSpreadsheet.Cells(iRow, iCol).Value = s_Str
iRow = iRow + 1
objSpreadsheet.Range("A2:E2").Select
objSpreadsheet.Selection.Merge
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
objSpreadsheet.Cells(iRow, iCol).Halignment = 2
objSpreadsheet.Cells(iRow, iCol).Value = "业务发展情况(户)"
objSpreadsheet.Range("F2:I2").Select
objSpreadsheet.Selection.Merge
objSpreadsheet.Cells(iRow, iCol + 5).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol + 5).Font.Size = 10
objSpreadsheet.Cells(iRow, iCol + 5).Halignment = 2
objSpreadsheet.Cells(iRow, iCol + 5).Value = "日业务发展情况(元、分钟、次、户)"
objSpreadsheet.Range("J2:M2").Select
objSpreadsheet.Selection.Merge
objSpreadsheet.Cells(iRow, iCol + 9).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol + 9).Font.Size = 10
objSpreadsheet.Cells(iRow, iCol + 9).Halignment = 2
objSpreadsheet.Cells(iRow, iCol + 9).Value = "月累计业务发展情况(元、分钟、次、户)"
iRow = iRow + 1
For Each objField in objRS.Fields
objSpreadsheet.Columns(iCol).AutoFitColumns
'设置Excel表里的字体
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
objSpreadsheet.Cells(iRow, iCol).Halignment = 2 '居中
Select Case iCol
Case 1
objSpreadsheet.Cells(iRow, iCol).Value = "日期"
Case 2
objSpreadsheet.Cells(iRow, iCol).Value = "日新增"
Case 3
objSpreadsheet.Cells(iRow, iCol).Value = "日销户"
Case 4
objSpreadsheet.Cells(iRow, iCol).Value = "月累计净增"
Case 5
objSpreadsheet.Cells(iRow, iCol).Value = "期末到达"
Case 6
objSpreadsheet.Cells(iRow, iCol).Value = "业务收入"
Case 7
objSpreadsheet.Cells(iRow, iCol).Value = "业务时长"
Case 8
objSpreadsheet.Cells(iRow, iCol).Value = "业务拨打次数"
Case 9
objSpreadsheet.Cells(iRow, iCol).Value = "产生收入的业务用户数"
Case 10
objSpreadsheet.Cells(iRow, iCol).Value = "业务收入"
Case 11
objSpreadsheet.Cells(iRow, iCol).Value = "业务时长"
Case 12
objSpreadsheet.Cells(iRow, iCol).Value = "业务拨打次数"
Case 13
objSpreadsheet.Cells(iRow, iCol).Value = "产生收入的业务用户数"
End Select
iCol = iCol + 1
Next
'objField
'Display all of the data
Do While Not objRS.EOF
iRow = iRow + 1
iCol = iColOffset
For Each objField in objRS.Fields
If IsNull(objField.Value) then
objSpreadsheet.Cells(iRow, iCol).Value = ""
Else
If iCol = 1 Then
objSpreadsheet.Cells(iRow, iCol).Value = Left(objField.Value,4) + "-" + Mid(objField.Value,5,2) + "-" + Right(objField.Value,2)
Else
objSpreadsheet.Cells(iRow, iCol).Value = objField.Value
End If
objSpreadsheet.Columns(iCol).AutoFitColumns
objSpreadsheet.Cells(iRow, iCol).Font.Bold = False
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
End If
iCol = iCol + 1
Next 'objField
objRS.MoveNext
Loop
iRow = iRow + 1
iCol = iColOffset
With objSpreadsheet
.Range("A"&iRow&":L"&iRow).Select
.Selection.Merge
.Cells(iRow, iCol).Font.Bold = False
.Cells(iRow, iCol).Font.Size = 10
.Cells(iRow, iCol).Halignment = 2
.Cells(iRow, iCol).Value = "说明"
End With
End Sub
Function SaveWorksheet(strFileName)
'Save the worksheet to a specified filename
On Error Resume Next
Call objSpreadsheet.ActiveSheet.Export(strFileName, 0)
SaveWorksheet = (Err.Number = 0)
End Function
End Class
%>
下面是调用这个类文件的过程:
OutExcel.asp
<!-- #include file="Excel.inc" -->
<%
Set Conn = GetConn()'建立数据库连接对象
i_Type = Trim(Replace(Request.QueryString("Type"),"'",""))
If i_Type = "1" Then
s_Type = "vip模式"
ElseIf i_Type = "0" Then
s_Type = "普通模式"
Else
Response.Write("参数出错!")
Response.End()
End If
m_begindate = trim(request("byear"))&"-"&trim(request("bmonth"))&"-"&trim(request("bday"))
m_enddate = trim(request("eyear"))&"-"&trim(request("emonth"))&"-"&trim(request("eday"))
If Len(m_begindate) <> 10 Or Len(m_enddate) <> 10 Then
Response.Write("参数出错!")
Response.End()
End If
Dim objRS
Set objRS = Server.CreateObject("ADODB.Recordset")
s_Sql = "Select * "
s_Sql = s_Sql & " From tablename Where rq Between Convert(VarChar(8),Cast('"&m_begindate&"' As DateTime),112)"
s_Sql = s_Sql & " And Convert(VarChar(8),Cast('"&m_enddate&"' As DateTime),112) And MS='"&s_Type&"'"
objRS.Open s_Sql,Conn,1,3'根据条件取出数据
Dim SaveName
Dim objExcel
Dim ExcelPath
ExcelPath = "Excel/"&ConvertDate(Now)&".xls"'设置Excel文件名和路径
Set objExcel = New ExcelGen'建立类对象
objExcel.RowOffset = 1'设置列初始值
objExcel.ColumnOffset = 1'设置行初始值
objExcel.GenerateWorksheet objRS,i_Type'传入数据库记录集对象和标识
If objExcel.SaveWorksheet(Server.MapPath(ExcelPath)) then
Response.Write "<script>location.href='"&Replace(ExcelPath,"/","/") & "';</script>"
Else
Response.Write "在保存过程中有错误!"
End If
Set objExcel = Nothing
objRS.Close
Set objRS = Nothing
%>
我的注释写的不是特别的清楚,如有不懂的可以跟贴。