如何可以让用户自定义选择数据表，选择字段，然后导出成指定的格式Excel？现只要Copy以下两个文件存盘，稍作改动即可通用 其中conn.asp连接数据库的文件自己写啦。 首先，把以下代码存盘为Data_Import1.asp <!--#include file="include/conn.asp"-->
<%
TableN=Trim(Request("TableN"))
If TableN="" Then
TableN="TableNameA"
End If 'Response.Write Replace(Request.Form("TableIName"),","," ")
Set Rst=Server.CreateObject("Adodb.RecordSet")
Sqlt="Select * from " & TableN
Rst.Open Sqlt,conn,1,1 %>
<Script Language="JavaScript">
function SendParameter(tablevalue)
{
tvalue=tablevalue;
window.location.href="Data_Import.asp?TableN="+tvalue;
}
</Script>
<Script Language="JavaScript">
var check=0
function checkall() {
if(check==0){
for(var i=0;i<document.form1.TableIName.length;i++)
{
var e=document.form1.TableIName[i];
e.checked=true;
}
check=1;
document.form1.chk.alt="全否";
}else{
for(var i=0;i<document.form1.TableIName.length;i++)
{
var e=document.form1.TableIName[i];
e.checked=false;
}
check=0;
document.form1.chk.alt="全选";
}
}
</Script>
<html> <head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>导出数据</title>
</head> <body> <form method="POST" name="form1" action="Data_Import2.asp">
<p><select size="1" name="TableName" onchange="SendParameter(this.value);">
<option>---请选择表---</option>
<option value="TableNameA" >表A</option>
<option value="TableNameB" >表B</option>
<option value="TableNameC" >表C</option>
<option value="TableNameD" >表D</option>
<option value="TableNameE" >表E</option>
</select></p>
<p>
</p>
<table border="0" width="100%" id="table1">
<tr>
<%
'将字段名称循环读出
Dim RowCount
RowCount=1
ColCount = Rst.Fields.Count
For intCount= 0 to ColCount-1
%>
<td>
<input type="checkbox" name="TableIName" value="<%=ucase(Rst.Fields(intCount).Name)%>"><%=ucase(Rst.Fields(intCount).Name)%>
<%If RowCount mod 5 =0 Then%><tr></tr><%End If%>
</td>
<%
RowCount=RowCount+1
Next
Rst.Close
Set Rst=Nothing
%>
</tr>
</table>
<p>
</p>
<p> <input name="chk" type="checkbox" id="chk" onclick="checkall()">全选/不全选
</p>
<p align="center">
<input type="submit" value="下一步>>" name="submitbutton"></p>
<input type="hidden" name="TableN" value="<%=TableN%>">
</form>
<div align="center">
<% rs.close
conn.close
Set rs=nothing
Set conn=nothing
%>
</body>
</html> 以上只需要把“ <option>---请选择表---</option>”这一行以下的改成需要的表名即可（其实这里也可以使用Asp循环写出库里的所有的表，我懒得写了，只好写死算了） 把以下代码存盘为Data_Import2.asp <!--#include file="include/conn.asp"--> <%
IF Request.Form("TableIName")<>"" Then '以防上一页没有选择字段而造成asp死占内存 dim tablename,filetype,fieldPid
sql = "Select " & Request.Form("TableIName") & " from " & Request.Form("TableN")
tablename = Request.Form("TableN")
filetype = "csv"
fieldPid = request("pid")
if fieldPid = "" then
fieldPid = "id"
end if
fieldPid = lcase(fieldPid)
if lcase(left(sql,6))<>"select" then
Response.write "sql语句必须为select * from [table] where ......."
Response.end
end if if tablename = "" then
tablename = "数据导出结果"
end if 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 function Myreplace2(str)
if not isnull(str) then
fString = Replace(fString,"'", "''")
Myreplace2 = str
else
Myreplace2 = ""
end if
end function dim def_export_sep,def_export_val
def_export_sep = ","
def_export_val = """" Set rs = Conn.Execute(sql)
if filetype="csv" then
Response.contenttype="csv"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".csv"
strLine=""
For each x in rs.fields
strLine= strLine & def_export_val & x.name & 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 & Myreplace(x.value) & def_export_val & def_export_sep
Next
rs.MoveNext
Response.write strLine & vbnewline
Wend
else %> <html> <head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>导出数据</title>
</head>
<style>
<!--
body,input,select { font-family: Tahoma; font-size: 8pt }
th { font-family: Tahoma; font-size: 8pt;padding:3px;color:#FFFFFF;background-color:#C0C9E2;}
td { font-family: Tahoma; font-size: 8pt;padding:3px;background-color:#EFEFEF;}
-->
</style> <body> <div align="center">
<table width=98% border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
<tr>
<%
i=0
For each x in rs.fields
strLine= strLine &chr(9)&chr(9)&"<th align=""center"">"& x.name &"</th>"& vbnewline
Next
Response.write strLine&chr(9)&"</tr>"& 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
%>
</table><%=vbnewline%> <p style='line-height:160%;'><%=i%>条记录
<%
'response.write"<a href='?tablename="& tablename &"&pid="& fieldPid &"&filetype=csv&sql="&server.urlencode(sql)&"'>导出EXCEL</a>"
response.write vbnewline
end if
response.write vbnewline
Else
%>
</body>
</html>
<Script language="JavaScript">
alert("请至少选择一个字段名称！");
window.history.go(-1);
</Script>
<%
End If
%> 以上文件放在IIS下测试目录下即可通用。以上代码经过测试。希望大家可以继续完善它，开发出通用的模块出来。还有一个问题暂未解决的是，如何使字段列表是中文名？因为一般字段设计都是英文名，如何让列出的字段名为对应的中文名呢？还没有想到较好的方法。如果用do case语句的话，日后增加表或字段结构更改也是很麻烦。 
|
本类阅读TOP10