100分！如何将结果保存成Excel文件？
要求检索数据库后把结果生成一个Excel的文件，头疼。请各位高手指点。 问题点数：100、回复次数：7Top
1 楼youhao（勇攀高峰）回复于 2003-08-03 20:39:05 得分 100
利用ASP制作EXECL报表方法
很多时候我们需要把表格形式的数据转换成EXECL的形式呈现在用户面前，其中有好几个方法可以做到一点，我将介绍一种利用ASP完成的方法，该方法允许服务器动态地创建EXECL报表而且不用占用任何服务器空间。该方法还允许多个用户同时收到该数据。但是该方法至少需要EXECL 97的支持。
废话少说，要完成这个工作最重要的是要告诉浏览器HTTP头，就用如下代码：
<%
Response.ContentType = "application/vnd.ms-excel"
%>
下面来看一个例子，假设现在有如下形式的数据：
flavor qty_baked qty_eaten qty_sold price
Boston 24 2 10 0.5
Jelly 24 1 12 0.5
Strawberry 36 1 15 0.5
Chocolate 24 2 6 0.75
Maple 12 1 6 0.75
客户要求用EXECL的形式表现出来，并且希望其中能加上其他一些计算汇总
用如下代码：
……
<%
Response.ContentType = "application/vnd.ms-excel"
set conntemp=server.createobject("adodb.connection")
cnpath="DBQ=" & server.mappath("/stevesmith/data/timesheet.mdb")
conntemp.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & cnpath
set RS=conntemp.execute("select * from donut")
%>
<TABLE BORDER=1>
<TR>
<%
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' % Loop through Fields Names and print out the Field Names
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
j = 2 'row counter
For i = 0 to RS.Fields.Count - 1
%>
<TD><B><% = RS(i).Name %></B></TD>
<% Next %>
<TD><B>On Hand (calculated)</B></TD>
<TD><B>Gross (calculated)</B></TD>
</TR>
<%
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' % Loop through rows, displaying each field
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Do While Not RS.EOF
%>
<TR>
<% For i = 0 to RS.Fields.Count - 1
%>
<TD VALIGN=TOP><% = RS(i) %></TD>
<% Next %>
<TD>=b<%=j%>-c<%=j%>-d<%=j%></TD>
<TD>=d<%=j%>*e<%=j%></TD>
</TR>
<%
RS.MoveNext
j = j + 1
Loop
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' % Make sure to close the Result Set and the Connection object
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RS.Close
%>
<TR BGCOLOR=RED>
<TD>Totals</TD>
<TD>=SUM(B2:B6)</TD>
<TD>=SUM(C2:C6)</TD>
<TD>=SUM(D2:D6)</TD>
<TD>n/a</TD>
<TD>=SUM(F2:F6)</TD>
<TD>=SUM(G2:G6)</TD>
</TABLE>
……
这样我们就实现了目的，用户可以在浏览器窗口就打开它进行简单操作，也可以保存到硬盘上进行其他操作。我还将介绍一种利用filesystemobject操作的方法。请稍候。：）
废话少说，请看代码：
runquery.asp
<%@ LANGUAGE="VBSCRIPT" %>
<%
'DSNless connection to Access Database
strDSNPath = "PROVIDER=MSDASQL;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("testDB.mdb")
%>
<!--#include file="adovbs.inc" --> 请自己COPY这个文件
<%
server.scripttimeout=1000
Response.Buffer = True
if(Request.Form("ReturnAS") = "Content") then
Response.ContentType = "application/msexcel"
end if
Response.Expires = 0
dim oConn
dim oRS
dim strSQL
dim strFile
Set oConn = Server.CreateObject("ADODB.Connection")
Set oRS = Server.CreateObject("ADODB.Recordset")
strSQL = BuildSQL()
oRS.Open strSQL, strDSNPath, adOpenForwardOnly, adLockReadOnly, adCmdText
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>Excel Export Demo</title>
</head>
<body>
<%
if(Request.Form("ReturnAS") = "CSV") then
CreateCSVFile()
else if(Request.Form("ReturnAS") = "Excel") then
CreateXlsFile()
else if(Request.Form("ReturnAS") = "HTML") then
GenHTML()
else if(Request.Form("ReturnAS") = "Content") then
GenHTML()
end if
end if
end if
end if
Set oRS = Nothing
Set oConn = Nothing
Response.Flush
%>
</body>
</html>
<SCRIPT LANGUAGE=vbscript RUNAT=Server>
Function BuildSQL()
dim strSQL
dim strTemp
strTemp = ""
strSQL = "select year, region, sales_amt from sales"
if(Request.Form("Year") <> "ALL") then
strTemp = " where Year = "
strTemp = strTemp & Request.Form("Year")
end if
if(Request.Form("Region") <> "ALL") then
if(Len(strTemp) > 0) then
strTemp = strTemp & " and Region = "
else
strTemp = strSTL & " where Region = "
end if
strTemp = strTemp & "'"
strTemp = strTemp & Request.Form("Region")
strTemp = strTemp & "'"
end if
BuildSQL = strSQL & strTemp
End Function
Function GenFileName()
dim fname
fname = "File"
systime=now()
fname= fname & cstr(year(systime)) & cstr(month(systime)) & cstr(day(systime))
fname= fname & cstr(hour(systime)) & cstr(minute(systime)) & cstr(second(systime))
GenFileName = fname
End Function
Function GenHTML()
Response.Write("<DIV ALIGN=center><FONT SIZE=+1>Sales Reporting</FONT></DIV>")
Response.Write("<TABLE WIDTH=100% BORDER=1 CELLSPACING=1 CELLPADDING=1>")
Response.Write("<TR>")
Response.Write(" <TD>Year</TD>")
Response.Write(" <TD>Region</TD>")
Response.Write(" <TD>Sales</TD>")
Response.Write("</TR>")
if(oRS.BOF = True and oRS.EOF = True) then
Response.Write("Database Empty")
else
oRS.MoveFirst
Do While Not oRS.EOF
Response.Write("<TR>")
Response.Write("<TD>")
Response.Write(oRS.Fields("Year").Value)
Response.Write("</TD>")
Response.Write("<TD>")
Response.Write(oRS.Fields("Region").Value)
Response.Write("</TD>")
Response.Write("<TD>")
Response.Write(oRS.Fields("Sales_Amt").Value)
Response.Write("</TD>")
Response.Write("</TR>")
oRS.MoveNext
Loop
Response.Write("</TABLE>")
End if
End Function
Function CreateCSVFile()
strFile = GenFileName()
Set fs = Server.CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(server.MapPath(".") & "\" & strFile & ".csv",True)
If Not oRS.EOF Then
strtext = chr(34) & "Year" & chr(34) & ","
strtext = strtext & chr(34) & "Region" & chr(34) & ","
strtext = strtext & chr(34) & "Sales" & chr(34) & ","
a.WriteLine(strtext)
Do Until oRS.EOF
For i = 0 To oRS.fields.Count-1
strtext = chr(34) & oRS.fields(i) & chr(34) & ","
a.Write(strtext)
Next
a.Writeline()
oRS.MoveNext
Loop
End If
a.Close
Set fs=Nothing
Response.Write("Click <A HRef=" & strFile & ".csv>Here</A> to to get CSV file")
End Function
Function CreateXlsFile()
Dim xlWorkSheet ' Excel Worksheet object
Dim xlApplication
Set xlApplication = CreateObject("Excel.application")
xlApplication.Visible = False
xlApplication.Workbooks.Add
Set xlWorksheet = xlApplication.Worksheets(1)
xlWorksheet.Cells(1,1).Value = "Year"
xlWorksheet.Cells(1,1).Interior.ColorIndex = 5
xlWorksheet.Cells(1,2).Value = "Region"
xlWorksheet.Cells(1,2).Interior.ColorIndex = 5
xlWorksheet.Cells(1,3).Value = "Sales"
xlWorksheet.Cells(1,3).Interior.ColorIndex = 5
iRow = 2
If Not oRS.EOF Then
Do Until oRS.EOF
For i = 0 To oRS.fields.Count-1
xlWorksheet.Cells(iRow,i + 1).Value = oRS.fields(i)
xlWorkSheet.Cells(iRow,i + 1).Interior.ColorIndex = 4
Next
iRow = iRow + 1
oRS.MoveNext
Loop
End If
strFile = GenFileName()
xlWorksheet.SaveAs Server.MapPath(".") & "\" & strFile & ".xls"
xlApplication.Quit ' Close the Workbook
Set xlWorksheet = Nothing
Set xlApplication = Nothing
Response.Write("Click <A HRef=" & strFile & ".xls>Here</A> to get XLS file")
End Function
</script>
%>
Top
2 楼youhao（勇攀高峰）回复于 2003-08-03 20:39:16 得分 0
main.htm
<!-- frames -->
<FRAMESET ROWS="20%,*">
<FRAME NAME="Request" SRC="request.html" MARGINWIDTH="10" MARGINHEIGHT="10" SCROLLING="auto" FRAMEBORDER="yes">
<FRAME NAME="Result" SRC="welcome.html" MARGINWIDTH="10" MARGINHEIGHT="10" SCROLLING="auto" FRAMEBORDER="yes">
</FRAMESET>
request.htm
<html>
<head>
<title>Sales Report Demo</title>
</head>
<body>
<DIV ALIGN="center"><FONT SIZE="+1">Sales Reporting</FONT></DIV>
<FORM ACTION="runquery.asp" METHOD="POST" target=Result>
Year <SELECT NAME="Year">
<OPTION VALUE="ALL">ALL</OPTION>
<OPTION VALUE="1995">1995</OPTION>
<OPTION VALUE="1996">1996</OPTION>
<OPTION VALUE="1997">1997</OPTION>
<OPTION VALUE="1998">1998</OPTION>
<OPTION VALUE="1999">1999</OPTION>
</SELECT>
Region <SELECT NAME="Region">
<OPTION VALUE="ALL">ALL</OPTION>
<OPTION VALUE="North">North</OPTION>
<OPTION VALUE="East">East</OPTION>
<OPTION VALUE="South">South</OPTION>
<OPTION VALUE="West">West</OPTION>
</SELECT>
Return Results Using
<SELECT NAME="ReturnAS">
<OPTION VALUE="HTML">HTML Table</OPTION>
<OPTION VALUE="Content">Content Type</OPTION>
<OPTION VALUE="CSV">CSV</OPTION>
<OPTION VALUE="Excel">Native Excel</OPTION>
</SELECT>
<INPUT TYPE="Submit" NAME="Submit" VALUE="Submit">
</FORM>
</body>
</html>
welcome.htm
<html>
<head>
<title>Sales Report Demo</title>
</head>
<body>
</body>
</html>
数据库结构
testDB.Mdb
表sales
year 数字
Region 文本
Sales_Amt 货币
Top
3 楼yanfeng（烟峰）回复于 2003-08-04 08:09:05 得分 0
<%
'这是用OWC实现的！我试过可以用！你把这里objRS.Open "SELECT * FROM
'SeTable", "Provider=SQLOLEDB.1;Persist Security Info=True;User
'ID=xxxxx;Password=xxxx;Initial Catalog=xxxxxx;Data source=xxxx;"改成你的就可以了！
%>
<%
Option Explicit
Class ExcelGen
Private objSpreadsheet
Private iColOffset
Private iRowOffset
'''
Sub Class_Initialize()
Set objSpreadsheet = Server.CreateObject("OWC.Spreadsheet")
iRowOffset = 2
iColOffset = 2
End Sub
'''
Sub Class_Terminate()
'objSpreadsheet.quit
Set objSpreadsheet = Nothing 'Clean up
End Sub
'''
Public Property Let ColumnOffset(iColOff)
If iColOff > 0 then
iColOffset = iColOff
Else
iColOffset = 2
End If
End Property
'''
Public Property Let RowOffset(iRowOff)
If iRowOff > 0 then
iRowOffset = iRowOff
Else
iRowOffset = 2
End If
End Property
'''
Sub GenerateWorksheet(objRS)
'Populates the Excel worksheet based on a Recordset's contents
'Start by displaying the titles
If objRS.EOF then Exit Sub
Dim objField, iCol, iRow
iCol = iColOffset
iRow = iRowOffset
For Each objField in objRS.Fields
objSpreadsheet.Cells(iRow, iCol).Value = objField.Name
objSpreadsheet.Columns(iCol).AutoFitColumns
'设置Excel表里的字体
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
objSpreadsheet.Cells(iRow, iCol).Halignment = 2 '居中
iCol = iCol + 1
Next 'objField
'Display all of the data
Do While Not objRS.EOF
iRow = iRow + 1
iCol = iColOffset
For Each objField in objRS.Fields
If IsNull(objField.Value) then
objSpreadsheet.Cells(iRow, iCol).Value = ""
Else
objSpreadsheet.Cells(iRow, iCol).Value = objField.Value
objSpreadsheet.Columns(iCol).AutoFitColumns
objSpreadsheet.Cells(iRow, iCol).Font.Bold = False
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
End If
iCol = iCol + 1
Next 'objField
objRS.MoveNext
Loop
End Sub
'''
Function SaveWorksheet(strFileName)
'Save the worksheet to a specified filename
On Error Resume Next
Call objSpreadsheet.ActiveSheet.Export(strFileName, 0)
SaveWorksheet = (Err.Number = 0)
End Function
End Class
'''''
''''''
Dim objRS,StrSQL,StrConn
Set objRS = Server.CreateObject("ADODB.Recordset")
StrConn="Provider=SQLOLEDB;network library=dbmssocn;User ID=sa;password=;Initial Catalog=excel;Data Source=127.0.0.1,1433"
StrSQL="SELECT * FROM men"
objRS.Open StrSQL, StrConn
Dim SaveName
SaveName = "zhf" 'Request.Cookies("savename")("name")
Dim objExcel
Dim ExcelPath
ExcelPath = "Excel\" & SaveName & ".xls"
Set objExcel = New ExcelGen
objExcel.RowOffset = 1
objExcel.ColumnOffset = 1
objExcel.GenerateWorksheet(objRS)
If objExcel.SaveWorksheet(Server.MapPath(ExcelPath)) then
Response.Write "<html><body bgcolor='gainsboro' text='#000000'>下载已保存为Excel文件. <a href='" & server.URLEncode(ExcelPath) & "'>下载</a>"
Else
Response.Write "在保存过程中有错误!"
End If
Set objExcel = Nothing
objRS.Close
Set objRS = Nothing
%>Top
4 楼earthpea（问莲根，有丝多少？莲心知为谁苦？）回复于 2003-08-04 08:10:30 得分 0
楼上的正确
还有，如果你先搜索一下以前的问题的话，就不用出这100分了：）Top
5 楼xjdawu（无法界定）回复于 2003-08-04 08:17:28 得分 0
哎呀，不好意思，有时候我们也捡捡垃圾买点钱，生活难啊... ...Top
6 楼bigcrocodile（大鳄鱼）回复于 2003-08-05 09:40:59 得分 0
也要多提携后备Top
7 楼brmao（）回复于 2003-08-05 22:11:26 得分 0
分有什么大不了的。除了问问题我还没发现有其它作用。Top
