<%
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>