asp写入excel

<%@ LANGUAGE="VBSCRIPT" %>

<%option explicit%>

生成EXCEL文件

---

<%

if Request("act") = "" then

Response.Write "生成EXCEL文件"

else

dim conn,strconn

strconn="driver={SQL Server};server=xxx;uid=sa;pwd=;database=DB_Test" set conn=server.CreateObject("adodb.connection")

conn.Open strconn

dim rs,sql,filename,fs,myfile,x

Set fs = server.CreateObject("scripting.filesystemobject")

'--假设你想让生成的EXCEL文件做如下的存放

filename = Server.MapPath("online.xls")

'--如果原来的EXCEL文件存在的话删除它

if fs.FileExists(filename) then

fs.DeleteFile(filename)

end if

'--创建EXCEL文件

set myfile = fs.CreateTextFile(filename,true)

Set rs = Server.CreateObject("ADODB.Recordset")

'--从数据库中把你想放到EXCEL中的数据查出来

sql = "select * from Tb_Execl order by sort desc"

rs.Open sql,conn

if rs.EOF and rs.BOF then

Response.Write "库里暂时没有数据！"

else

dim strLine,responsestr

strLine=""

For each x in rs.fields

strLine= strLine & https://www.360docs.net/doc/4010863113.html, & 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

conn.close

set conn = nothing

set myfile = nothing

Set fs=Nothing

end if

%>

<%

dim s,sql,filename,fs,myfile,x,rs

Set fs = server.CreateObject("scripting.filesystemobject")

'--假设你想让生成的EXCEL文件做如下的存放

filename = Server.MapPath("users.xls")

'--如果原来的EXCEL文件存在的话删除它

if fs.FileExists(filename) then

fs.DeleteFile(filename)

end if

'--创建EXCEL文件

set myfile = fs.CreateTextFile(filename,true)

Set rs = Server.CreateObject("ADODB.Recordset")

'--从数据库中把你想放到EXCEL中的数据查出来

sql = "select * from product order by id desc"

rs.Open sql,conn

StartTime = Request("StartTime")

EndTime = Request("EndTime")

StartEndTime = "AddTime between #"& StartTime &" 00:00:00# and #"& EndTime &" 23:59:59#"

strSql = "select * from product order by id desc"

Set rstData =conn.execute(strSql)

if not rstData.EOF and not rstData.BOF then

dim trLine,responsestr

strLine=""

strline = strline & "设备名称" & chr(9) & "设备编码" & chr(9) & "设备型号" & chr(9) & "设备简介" & chr(9) & "配发时间" & chr(9) & "库存情况" & chr(9) & "单价（元）" & chr(9) & "存放地" & chr(9)

'--将表的列名先写入EXCEL

myfile.writeline strLine

Do while Not rstdata.EOF

strLine=""

strLine = strLine & rs("name")& chr(9) & rs("type")& chr(9) & rs("mark") & c hr(9) & rs("introduce")&chr(9) & rs("adddate")& chr(9) & rs("amount")& chr(9) & rs("p rice1")& chr(9) & rs("bzz1")& chr(9)

myfile.writeline strLine

rstData.MoveNext

loop

end if

Response.Write "生成EXCEL文件成功，点击右键目标另存为下载！"

rstData.Close

set rstData = nothing

Conn.Close

Set Conn = nothing

%>

常要把各种各样的查询结果输出到EXCEL中，所以做了下面这段小程序，用于把一个SQL 的SELECT查询出的结果输出为EXCEL格式文件，这个程序你只要设好用于取得一个记录集的SQL的SELECT查询语句和一个文件名，程序就能输出EXCEL格式文件了，这个程序一共由三个文件构成，第一个文件的文件名为：toexcel.asp是主文件，内容如下：

<%

'前面是和来链接到数据库,请自行书写相关语句，此处略过

sql=session("toexcelsql") '这里是要输出EXCEL的查询语句，如 "SESECT * FORM CAI WHERE 性别='女'"

filename="excel.xls" ' 要输出的EXCEL文件的文件名, 你只要改以上两句就行了,其它的都不要改.

'你只要修改以上两变量就行了.其它的我都做好了.

call toexcel(FILENAME,sql)

set conn=nothing

function ReadT ext(FileName) '这是一个用于读出文件的函数

set adf=server.CreateObject("Adodb.Stream")

with adf

.Type=2

.LineSeparator=10

.Open

.LoadFromFile (server.MapPath(FileName))

.Charset="GB2312"

.Position=2

ReadText=.ReadText

.Cancel()

.Close()

end with

set ads=nothing

end function

sub SaveText(FileName,Data) '这是一个用于写文件的函数

set fs= createobject("scripting.filesystemobject")

set ts=fs.createtextfile(server.MapPath(FileName),true)

ts.writeline(data)

ts.close

set ts=nothing

set fs=nothing

end sub

sub toexcel(filename,sql) '这是一个根据SQL语句和FILENAME生成EXCEL文件

Set rs=Server.CreateObject("ADODB.RecordSet")

rs.Open sql,conn,1,3

TOEXCELLR="

"

set myfield=rs.fields

dim fieldname(50)

for i=0 to myfield.count-1

toexcellr=toexcellr&"

"

fieldname(i)=myfield(i).name

if myfield(i).type=135 then datename=datename&myfield(i).name&","

next

toexcellr=toexcellr&"

"

do while not rs.eof

toexcellr=toexcellr&"

"

for i=0 to myfield.count-1

if instr(datename,fieldname(i)&",")<>0 then

if not isnull(rs(fieldname(i))) then

TOEXCELLR=TOEXCELLR&"

"

else

TOEXCELLR=TOEXCELLR&"

"

end if

else

TOEXCELLR=TOEXCELLR&"

"

end if

next

toexcellr=toexcellr&"

"

rs.movenext

loop

toexcellr=toexcellr&"

"&MYFIELD(I).NAME&"
"&formatdatetime(rs(fieldna me(i)),2)&"		"&rs(fieldname(i))&"

"

tou=readtext("tou.txt")

di=readtext("di.txt")

toexcellr=tou&toexcellr&di

call savetext(filename,toexcellr)

end sub

%>

正在生成EXLCE文件....

＊＊＊＊＊＊＊＊＊＊＊＊＊＊第二个文件名为：di.txt 内容如下：

＊＊＊＊＊＊＊＊＊＊＊＊第三个文件的文件名为：tou.TXT内容如下：

xmlns:x="urn:schemas-microsoft-com:office:excel"

xmlns="https://www.360docs.net/doc/4010863113.html,/TR/REC-html40">

Sheet1

225

9

-3 0

3

24

5

False

False

False

Sheet2

225

False

False

False

Sheet3

225

False

False

False

6600

12000

0

1395

False

False

上面的方法不用Excel支持，这对于虚拟主机来说很重要。

________________________________________________________________

我用rs.GetString做了改进，速度快了很多：

________________________________________________________________

sub toExcel(filename,sql) '这是一个根据SQL语句和FILENAME生成EXCEL文件

Set rs=Server.CreateObject("ADODB.RecordSet")

rs.Open sql,oProductConn,1,3

TOEXCELLR="

"

set myfield=rs.fields

dim fieldname(50)

for i=0 to myfield.count-1

toexcellr=toexcellr&"

"

fieldname(i)=myfield(i).name

if myfield(i).type=135 then datename=datename&myfield(i).name&","

next

toexcellr=toexcellr&"

"&chr(13)&chr(13)&""

' for i=0 to myfield.count-1

' 'if instr(datename,fieldname(i)&",")<>0 then

' if not isnull(rs(fieldname(i))) then

' TOEXCELLR=TOEXCELLR&"

"

' else

' TOEXCELLR=TOEXCELLR&"

"

' end if

'else

' TOEXCELLR=TOEXCELLR&"

"

'end if

' TOEXCELLR=TOEXCELLR&"

"

' next

' toexcellr=toexcellr&"

"

' rs.movenext

'loop

toexcellr=toexcellr&"

"&MYFIELD(I).NAME&"
" tmpStr=rs.getString(,,"	","
","") '用getString提搞速度，by LazyBoy QQ:59219588 toexcellr=toexcellr&left(tmpStr,len(tmpStr)-20) 'do while not rs.eof ' toexcellr=toexcellr&"
"&formatdatetime(rs (fieldname(i)),2)&"		"&rs(fieldname(i))&"	"&rs.Fields.Field(i).value&"

" tou=readtext("tou.txt")

di=readtext("di.txt")

toexcellr=tou&toexcellr&di

call savetext(filename,toexcellr) end sub