将记录集存为EXCEL的问题

[njhxc]

以前在VB版找到一段代码将记录集存为EXCEL，我把这段代码移值到ASP中很长时间不出结果，各位帮忙看一下
<%
stropen="select fee_date,sum(charge_dkh) dkh,sum(charge_sy) sy,sum(charge_gz1) gz1,sum(charge_gz2) gz2,sum(charge_lc) lc,sum(charge_wy) wy,sum(charge_zz) zz from njdx_tj_qf_day_charge_new where rf_date_time='20050426' group by fee_date"

set Rs_Data=server.createobject("adodb.recordset")
set oracle_conn=server.createobject("adodb.connection")
oracle_conn.open connstr
rs_data.open stropen,oracle_conn,1,1




If rs_data.RecordCount < 1 Then
Response.Redirect "ERROR.asp?ID=004"
End If
'记录总数
Irowcount = rs_data.RecordCount
'字段总数
Icolcount = rs_data.Fields.Count


Set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().Add
Set xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True

'添加查询语句，导入EXCEL数据
Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))



xlQuery.FieldNames = True '显示字段名
xlQuery.Refresh

With xlSheet
.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
'设标题为黑体字
.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
'设表格边框样式
End With

With xlSheet.PageSetup
.LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称：" ' & Gsmc
.CenterHeader = "&""楷体_GB2312,常规""大客户收入&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期："
.RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10部门："
.LeftFooter = "&""楷体_GB2312,常规""&10制表人："
.CenterFooter = "&""楷体_GB2312,常规""&10制表日期："
.RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
End With

xlApp.Application.Visible = True
Set xlApp = Nothing '"交还控制给Excel
Set xlBook = Nothing
Set xlSheet = Nothing
Set Rs_Data = Nothing
%>

[孟子E章]

服务器端使用Excel.Application有限制的，权限
http://support.microsoft.com/kb/288367/zh-cn

另外
xlApp.Visible = False

[hqcsx]

<!--#include file="../conn/conn.asp"-->
<%
'导出xml,csv,htm文件DEMO
'用法：ExportDB.asp?t=文件类型&sql=sql语句
'文件类型可以是htm,csv,xml，默认是htm
'http://www.51windows.Net
'tablename = "htm"
Dim shijian,dingdan
shijian = now()
dingdan = year(shijian)&month(shijian)&day(shijian)&hour(shijian)&minute(shijian)&second(shijian)

dim tablename
sql2 = request("sql")
tablename = request("tablename")
if tablename = "" then
tablename = "数据导出结果"&dingdan
else
tablename = tablename&dingdan
end if
sql = replace(sql2,";","")

filetype = lcase(request("t"))
dim dbid,IndexPageName
function HTMLEncode(fString)
if not isnull(fString) then

fString = Server.HTMLEncode(fString)
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
fString = Replace(fString, CHR(9), "  ")

HTMLEncode = fString
end if
end function

function Myreplace(str)
if not isnull(str) then
fString = Replace(fString,"""", """""")
Myreplace = str
else
Myreplace = ""
end if
end function

dim def_export_val
def_export_sep = ","
def_export_val = """"
if lcase(left(sql,6))<>"select" then
Response.write "出错了。。。"
Response.end
end if
Set rs = Conn.Execute(sql)
if filetype="xml" then
Response.contenttype="text/xml"
Response.Charset = "gb2312"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".xml"
Response.write "<?xml version=""1.0"" encoding=""gb2312""?>"
Response.write vbnewline&"<root>"
strLine=""
dim thefield(50)
i = 0
For each x in rs.fields
thefield(i)=x.name
i=i+1
Next
While rs.EOF =false
strLine= vbnewline&chr(9)&"<row>"
k=0
For each x in rs.fields
strLine= strLine & vbnewline&chr(9)&chr(9)&"<"&thefield(k)&">"
if instr(x.value,"<") or instr(x.value,">") or len(x.value)>255 then
strLine= strLine &"<![CDATA["& x.value &"]]>"
else
strLine= strLine & x.value
end if
strLine= strLine &"</"&thefield(k)&">"


k=k+1
Next
rs.MoveNext
Response.write strLine &vbnewline& chr(9)&"</row>"
Wend
Response.write vbnewline&"</root>"
elseif filetype="csv" then
'Response.contenttype="application/vnd.ms-excel"
Response.contenttype="text/csv"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".csv"



strLine=""
strLine="""会员帐号"",""高级会员"",""真实姓名"",""电子邮件"",""联系电话"",""联系传真"",""移动电话"",""邮政编码"",""联系地址"",""公司名称"",""密码提示问题"",""密码提示答案"",""登录次数"",""最后登录时间"",""注册时间"","

For each x in rs.fields
'strLine= strLine & def_export_val & def_export_val & def_export_sep
Next
Response.write strLine & vbnewline
While rs.EOF =false
strLine= ""
For each x in rs.fields
strLine= strLine & def_export_val & trim(Myreplace(x.value)) & def_export_val & def_export_sep
Next
rs.MoveNext
Response.write strLine & vbnewline
Wend
else
if filetype="htm" then'弹出下载html的对话框
Response.contenttype="application/ms-download"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".htm"
end if
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<!--META NAME="Author" CONTENT="51windows,海娃,haiwa">
<META NAME="Description" CONTENT="Power by 51windows.Net"-->
<title>导出数据。。</title>
<style>
<!--
body { font-family: Verdana; font-size: 11px }
th { font-family: Verdana; font-size: 11px;padding:3px;color:#FFFFFF;background-color:#999999;}
td { font-family: Verdana; font-size: 11px;padding:3px;background-color:#EFEFEF;}
-->
</style>
</head>
<BODY style="overflow:auto;" topmargin=2 bgcolor=buttonface oncontextmenu=self.event.returnValue=false >
<div align="center">
<table border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
<tr>
<th align="center">会员帐号</th>
<th align="center">高级会员</th>
<th align="center">真实姓名</th>
<th align="center">电子邮件</th>
<th align="center">联系电话</th>
<th align="center">联系传真</th>
<th align="center">移动电话</th>
<th align="center">邮政编码</th>
<th align="center">联系地址</th>
<th align="center">公司名称</th>
<th align="center">密码提示问题</th>
<th align="center">密码提示答案</th>
<th align="center">登录次数</th>
<th align="center">最后登录时间</th>
<th align="center">注册时间</th>
</tr>
<%
i=0
For each x in rs.fields
strLine= strLine &chr(9)&chr(9)& vbnewline
Next
Response.write strLine&chr(9)& vbnewline & vbnewline
While rs.EOF =false
i=i+1
Response.write chr(9)&"<tr>"& vbnewline
strLine= ""
For each x in rs.fields
strLine= strLine &chr(9)&chr(9)&"<td>"& HTMLEncode(x.value) &"</td>"& vbnewline
Next
rs.MoveNext
Response.write strLine
Response.write chr(9)&"</tr>"& vbnewline & vbnewline
Wend
Response.write "</table>"& vbnewline
if filetype<>"htm" and filetype<>"xls" and filetype<>"txt" then
Response.write "<p style='line-height:160%;'>"&i&"条记录 <a href='?tablename="&request("tablename")&"&t=htm&sql="&server.urlencode(sql2)&"'>导出HTML</a>|<a href='?tablename="&request("tablename")&"&t=csv&sql="&server.urlencode(sql2)&"'>导出EXCEL</a>|<a href='?tablename="&request("tablename")&"&t=xml&sql="&server.urlencode(sql2)&"'>导出XML</a>"& vbnewline
end if
'Response.write "<p>Power by <A HREF=""http://www.51windows.Net"" target=""_blank"">51windows.Net</A>"& vbnewline
Response.write "</div>"& vbnewline
Response.write "</BODY>"& vbnewline
Response.write "</HTML>"& vbnewline
%>

<%
end if

rs.close
conn.close
Set rs=nothing
Set conn=nothing
%>


**********************************************************************************


<%
member_name = trim(request("member_name"))
member_sex = trim(request("member_sex"))
member_popedom = trim(request("member_popedom"))
sql2 = "select member_name,member_popedom,member_nickname,member_email,member_phone,member_fax,mobile_phone,member_postalcode,member_address,member_company,member_question,member_answer,member_count,now_date,now_first from member where member_id >= 1 "
if member_name <> "" then
sql_member_name = " and member_name like '%"&member_name&"%' "
sql2 = sql2 + sql_member_name
end if
if member_sex <> "" then
sql_member_sex = " and member_sex='"&member_sex&"' "
sql2 = sql2 + sql_member_sex
end if
if member_popedom <> "" then
sql_member_popedom = " and member_popedom = "&member_popedom&" "
sql2 = sql2 + sql_member_popedom
end if
sql2 = sql2 + " order by now_first desc "
%>

<input name="Submit" type="button" class="cabinput" value="导出网页" onClick="window.location.href='ExportDB.asp?t=htm&sql=<% = server.URLEncode(sql2) %>'" >
  
<input name="Submit" type="button" class="cabinput" value="导出表格" onClick="window.location.href='ExportDB.asp?t=csv&sql=<% = server.URLEncode(sql2) %>'">