继续ASP2EXCEL
注意:本文最后更新于 2760 天前,有关的内容可能已经发生变化,请参考使用。
帮学校做个系统 ASP的 今天晚上解决一系列问题之后遇到一个比较纠结的问题asp控制Excel的Xls属性问题
尝试了一下用下面的两种方法
第一种通用性更强 适合大多数主机
第二种用起来比较方便 对Excel操作更好 但是对主机的环境要求颇为苛刻
明眼人一看就知道第一种其实就是通过asp的一个组件直接写数据 把查询到的数据直接写到文件里 这么一来让EXCEL自己去识别成XLS 虽然有些牵强但是效果还是很好的 所以以前做东西我更喜欢第一种方法 但是问题在于这次做的系统的数据库有很多的学号 考号之类的 都是很长一段的数字 这种情况下用第一种方法的结果是长数字被EXCEL直接当作数字类型 用科学计数法表示
实在是很Onz。。。。。 又因为这种生成xls文件的特殊性 所以基本没有什么办法来解决这个问题
dim path
path=server.MapPath("report.xls")
set fso=server.CreateObject("Scripting.filesystemobject")
if fso.FileExists(path) then
fso.deletefile(path)
end if
set myfile=fso.createtextfile(path,true)
set rs=server.CreateObject("adodb.recordset")
rs.open str,conn,3,4
if rs.EOF and rs.BOF then
Response.Write "暂时没有数据!"
else
dim strLine,responsestr
strLine=""
For each x in rs.fields
strLine= strLine & x.name & chr(9)
Next
'--将表的列名先写入EXCEL
myfile.writeline strLine
Do while Not rs.EOF
strLine=""
for each x in rs.Fields
strLine= strLine &" "&x.value&" "& chr(9)
next
'--将表的数据写入EXCEL
myfile.writeline strLine
rs.MoveNext
loop
end if
rs.Close
set rs = nothing
set myfile = nothing
Set fs=Nothing
rs.open str,conn,3,4 '这里用sql语句查询需要导出的内容
'On error resume next
if rs.eof then
Response.write "没有记录可导出! "
rs.close
set rs=nothing
response.End()
end if
Dim App,Book,Shts,Sht
set App = CreateObject("Excel.Application")
App.Visible = False '无需打开excel
App.DisplayAlerts =true '不显示警告
App.Application.Visible = false '不显示界面
'添加Excel表
App.WorkBooks.add
set Book = App.ActiveWorkBook
set Shts = Book.Worksheets
set Sht = Book.Sheets(1)
kk=0
for j=1 to recordcounts
if request.Form("checkbox"&j)<>"" then
Sht.Range(chr(asc("A")+int(kk))&"1:"&chr(asc("A")+int(kk))&"1").Value =request.Form("checkbox"&j)
Sht.Columns("A:A").NumberFormatLocal = "0_ "
kk=kk+1
end if
next
Dim r '行数
r=2 '从第二行开始写
Dim DeferOctEmp,IsCheck
do while not rs.eof
kk=0
for j=1 to recordcounts
kindname=request.Form("checkbox"&j)
if request.Form("checkbox"&i)="考生号" then kindname="ksh"
if request.Form("checkbox"&i)="录取号" then kindname="lqh"
if request.Form("checkbox"&i)="专业" then kindname="录取大专业"
if request.Form("checkbox"&i)="接收单位隶属部门" then kindname="单位隶"
if request.Form("checkbox"&i)="协议书编号" then kindname="xysh"
if kindname<>"" then
if not isnull(rs(""&kindname&"")) or trim(rs(""&kindname&""))<>"" then Sht.Range(chr(asc("A")+int(kk))&r&":"&chr(asc("A")+int(kk))&r).Value=rs(""&kindname&"")
kk=kk+1
end if
next
rs.movenext
r=r+1
loop
rs.close
set rs=nothing
'设置自动列宽
'Sht.Range("A1:"&chr(asc("A")+int(recordcounts-1))&(r-1)).Columns.AutoFit
'保存Excel文件
Dim ExcelFile
ExcelFile="Excel/ecjtu"&session("user")&".xls"
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if fso.fileexists(Server.MapPath(ExcelFile)) then fso.deleteFile(Server.MapPath(ExcelFile))
set fso=nothing
Book.SaveAs Server.MapPath(ExcelFile)
if err.Number<>0 then
Response.write err.Description
App.Quit
set App = Nothing
response.end
end if
Book.Save
App.Quit
set App = Nothing
Response.Redirect ExcelFile
「倘若有所帮助,不妨酌情赞赏!」
感谢您的支持!
使用微信扫描二维码完成支付