<%
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()
Set objSpreadsheet = Nothing
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)
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
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
Do While Not objRS.EOF
iRow = iRow 1
iCol = iColOffset
For i=0 to objrs.fields.count-1
If IsNull(objrs.fields(i).value) then
objSpreadsheet.Cells(iRow, iCol).Value = " "
Elseif i=3 then
objSpreadsheet.Cells(iRow, iCol).Value = cstr(objrs.fields(i).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
else
objSpreadsheet.Cells(iRow, iCol).Value = objrs.fields(i).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
objRS.MoveNext
Loop
End Sub
Function SaveWorksheet(strFileName)
On Error Resume Next
Call objSpreadsheet.ActiveSheet.Export(strFileName, 0)
SaveWorksheet = (Err.Number = 0)
End Function
End Class
Dim objRS
Set objRS = Server.CreateObject( "ADODB.Recordset ")
Set con=Server.Createobject( "ADODB.Connection ")
con.open "provider=microsoft.jet.oledb.4.0;data source= "& server.MapPath( ". "& "/database/project.mdb ")
objRS.Open session( "sql "), con,1,1
Dim SaveName
SaveName = 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( "c:/test.xls ") then %>
<script language= "javascript ">
window.alert( "數據已經保存在C盤下test.xls文件里，請核實. ");
history.back();
</script>
<%
Else
Response.Write( " <script language=javascript> window.alert(數據保存失敗。); </script> ")
End If
Set objExcel = Nothing
objRS.Close
Set objRS = Nothing
%>
================
session( "Sql ")保存的是查詢的sql語句
運行完后test.xls就保存在了服務器上了。但是我想保存在客戶端上（在客戶端上運行完后保存在了服務器上 服務器是運行iis這臺機子）
客戶端:
查詢頁面: <input type=button value= "導出 " onClick= "javascript:export_onclick(); ">
function export_onclick()
{
window.location.href = "rp_export.asp?reports_sql= " sql;//這里的sql可以用你的session( "Sql ")
}
rp_export.asp:
<%@ Language=VBScript%>
<html>
<head>
<meta http-equiv= "Content-Type " content= "text/html; charset=gb2312 ">
<title> 無標題文檔 </title>
</head>
<body>
<%
Response.Clear
Response.ContentType = "text/xls "
Response.AddHeader "content-disposition ", "attachment; filename=export.xls "
set conn=server.createobject( "adodb.connection ")
conn.open "sql server驅動 "
SQL=session( "Sql ")
Set rs=conn.execute(SQL)
total=rs.fields.count
while not rs.eof
i=0
while i <cint(total)
Data=Data&rs(i)&chr(9)
i=i 1
wend
Response.Write Data&chr(13)
Data= " "
rs.moveNext
wend
rs.close
conn.close
Response.Flush
Response.End
%>
</body>
</html>
400 186 1886
