我写的一个将数据库数据导出到EXCEL的类(ASP)

王朝asp·作者佚名  2006-01-09
宽屏版  字体: |||超大  

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 debug(varStr)

' response.write varStr

' response.end

'End Function

'类结束

End Class

%>

tesp.asp

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

<!--#include file="clsExport2Excel.asp"-->

<!DOCTYPE HTML PUBLIC "-//W3C//DTD 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>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
© 2005- 王朝网络 版权所有