分享
 
 
 

我写的一个将数据库数据导出到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>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有