我写的一个将数据库数据导出到EXCEL的类(ASP)
发表于:2007-06-30来源:作者:点击数:
标签:
clsExport2Excel.asp % @#类开始 Class clsExport2Excel @#声明常量、变量 Private strFilePath,strTitle,strSql,strField,strRows,strCols Private strCn,strHtml,strPath Private objDbCn,objRs Private objXlsApp,objXlsWorkBook,objXlsWorkSheet Private
clsExport2Excel.asp
<%
@#类开始
Class clsExport2Excel
@#声明常量、变量
Private strFilePath,strTitle,strSql,strField,strRows,strCols
Private strCn,strHtml,strPath
Private objDbCn,objRs
Private objXlsApp,objXlsWorkBook,objXlsWorkSheet
Private arrField
@#初始化类
Private Sub Class_Initialize()
strCn = "driver={
SQL Server};server=LIUHQ;UID=sa;PWD=sa;Database=MS"
set objDbCn = server.CreateObject("adodb.connection")
objDbCn.open strCn
strFilePath = ".\"
strTitle = "查询结果"
strRows = 2
strCols = 1
End Sub
@#销毁类
Private Sub Class_Terminate()
End Sub
@#属性FilePath
Public Property Let FilePath(value)
strFilePath = value
End Property
Public Property Get FilePath()
FilePath = strFilePath
End Property
@#属性Title
Public Property Let Title(value)
strTitle = value
End Property
Public Property Get Title()
Title = strTitle
End Property
@#属性Sql
Public Property Let Sql(value)
strSql = value
End Property
Public Property Get Sql()
Sql = strSql
End Property
@#属性Field
Public Property Let Field(value)
strField = value
End Property
Public Property Get Field()
Field = strField
End Property
@#属性Rows
Public Property Let Rows(value)
strRows = value
End Property
Public Property Get Rows()
Rows = strRows
End Property
@#属性Cols
Public Property Let Cols(value)
strCols = value
End Property
Public Property Get Cols()
Cols = strCols
End Property
@#
Public Function export2Excel()
if strSql = "" or strField = "" then
response.write "参数设置错误,请与管理员联系!谢谢"
response.end
end if
if right(strFilePath,1) = "/" or right(strFilePath,1) = "\" then
strFilePath = left(strFilePath,len(strFilePath)-1)
end if
if instr("/",strFilePath) > 0 then
strFilePath = replace(strFilePath,"/","\")
end if
strFilePath = strFilePath & "\"
set objFso = createobject("scripting.filesystemobject")
if objFso.FolderExists(server.mappath(strFilePath)) = False then
objFso.Createfolder(server.mappath(strFilePath))
end if
strFileName = strFilePath & cstr(createFileName()) & ".xls"
set objRs = server.CreateObject("adodb.RecordSet")
objRs.open strSql,objDbCn,3,3
if objRs.recordcount <= 0 then
strHtml = "暂时没有任何合适的数据导出,如有疑问,请与管理员联系!抱歉"
else
set objXlsApp = server.CreateObject("Excel.Application")
objXlsApp.Visible = false
objXlsApp.WorkBooks.Add
set objXlsWorkBook = objXlsApp.ActiveWorkBook
set objXlsWorkSheet = objXlsWorkBook.WorkSheets(1)
objXlsWorkSheet.Cells(1,1).Value = strTitle
arrField = split(strField,"||")
for f = 0 to Ubound(arrField)
objXlsWorkSheet.Cells(2,f+1).Value = arrField(f)
next
for c = 1 to objRs.recordcount
for f = 0 to objRs.fields.count - 1
@#@#@#身份证号码特殊处理
if objRs.fields(f).name = "pm_field_41325" or objRs.fields(f).name = "cardID" then
objXlsWorkSheet.Cells(c+2,f+1).Value = "@#" & objRs.fields(f).value
@#@#@#
就业特殊处理
elseif objRs.fields(f).name = "JiuYe" then
select case objRs.fields(f).value
case 1
objXlsWorkSheet.Cells(c+2,f+1).Value = "是"
case 0
objXlsWorkSheet.Cells(c+2,f+1).Value = "否"
case -1
objXlsWorkSheet.Cells(c+2,f+1).Value = "(未知)"
end select
else
objXlsWorkSheet.Cells(c+2,f+1).Value = objRs.fields(f).value
end if
next
objRs.movenext
next
objXlsWorkSheet.SaveAs server.mappath(strFileName)
strHtml = "Excel文件已经导出成功,您可以<a href=@#" & strFileName & "@# target=@#_blank@#>打开</a>文件并将文件另存到本地目录中!"
objXlsApp.Quit
set objXlsWorkSheet = nothing
set objXlsWorkBook = nothing
set objXlsApp = nothing
end if
objRs.close
set objRs = nothing
if err > 0 then
strHtml = "Excel文件导出时出现意外错误,请<a href=@##@# onclick=@#window.history.back();@#>返回</a>,如有疑问,请与管理员联系!抱歉"
end if
export2Excel = strHtml
End Function
@#函数
Public Function createFileName()
fName=now
fName=replace(fName,":","")
fName=replace(fName,"-","")
fName=replace(fName," ","")
createFileName=fName
End Function
@#Public Function de
bug(varStr)
@# response.write varStr
@# response.end
@#End Function
@#类结束
End Class
%>
tesp.asp
<%@LANGUAGE="
VBSCRIPT" CODEPAGE="936"%>
<!--#include file="clsExport2Excel.asp"-->
<!DOCTYPE HTML PUBLIC "-//W3C//D
TD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>无标题文档</title>
</head>
<body>
<%
set newExcel = New clsExport2Excel
newExcel.FilePath = "../excel/"
newExcel.Sql = "select name,cardID from usrPopulation"
newExcel.Title = "基本人口信息"
newExcel.Field = "姓名||身份证号||"
response.write newExcel.export2Excel()
%>
</body>
</html>
原文转自:http://www.ltesting.net