ASP导出EXCEL

XSL.ASP

<!--#include file="conn.asp"-->


<% 
Set xlApplication = Server.CreateObject("Excel.Application") '调用excel对象 
xlApplication.Visible = False '无需打开excel 
xlApplication.SheetsInNewWorkbook=1 '指定excel中表的数量 
xlApplication.Workbooks.Add '添加工作簿 
Set xlWorksheet = xlApplication.Worksheets(1) '生成第1个工作表的子对象 
xlWorksheet.name="统计" '指定工作表名称 
'指定列的宽度以及对齐方式 1左对齐 2右对齐 3居中
xlApplication.ActiveSheet.Columns(1).ColumnWidth=5  
xlApplication.ActiveSheet.Columns(1).HorizontalAlignment=3     
xlApplication.ActiveSheet.Columns(2).ColumnWidth=10 
xlApplication.ActiveSheet.Columns(2).HorizontalAlignment=3 
xlApplication.ActiveSheet.Columns(3).ColumnWidth=20
xlApplication.ActiveSheet.Columns(3).HorizontalAlignment=3 

'xlApplication.ActiveSheet.Rows(i).RowHeight = 30'行的高度 
'指定列的高度以及特定列 
xlWorksheet.Range(xlWorksheet.Cells(1,1), xlWorksheet.Cells(1,3)).MergeCells =True '合并列 
xlWorksheet.Range("A1").value="2005年统计" 
xlWorksheet.Range("A1").font.Size=14'字体大小 
xlWorksheet.Range("A1").font.bold=true'粗体 
xlWorksheet.Range("A1").HorizontalAlignment=3'水平对齐 
xlWorksheet.Range("A1").VerticalAlignment=3'垂直对齐 

xlWorksheet.Cells(2,1).Value = "编号" 
xlWorksheet.Cells(2,2).Value = "姓名" 
xlWorksheet.Cells(2,3).Value = "单位" 


'xlWorksheet.Range("A1:C1").Borders.LineStyle=1  '设置行style

'--------------------------------------------------自己可做循环i=i+1（数据库数据） 



i=1
strSql = "select * from excel"
Set rs =conn.execute(strSql)
if not rs.eof then
 do while not rs.eof 
 xlWorksheet.Cells(2+i,1).Value = rs(0)
 xlWorksheet.Cells(2+i,2).Value = rs(1)
 xlWorksheet.Cells(2+i,3).Value = rs(2)
 i=i+1
 rs.movenext
 loop
end if



'-------------------------------------------------- 



Set fs = CreateObject("Scripting.FileSystemObject") 
tfile=Server.MapPath("test.xls") 
if fs.FileExists(tfile) then 
Set f = fs.GetFile(tfile) 
f.delete true 
Set f = nothing 
end if 
Set fs = nothing 
xlWorksheet.SaveAs tfile '保存文件 
xlApplication.Quit '释放对象 
Set xlWorksheet = Nothing 
Set xlApplication = Nothing 
%> 
<p align="center"><a href="downfile.asp?fileSpec=<%=tfile%>">下载</a></p> 

downfile.asp

<% 
Function downLoadFile(FileSpec) 
on error resume next 
 Const ForReading=1 
 Const TristateTrue=-1  
 Const FILE_TRANSFER_SIZE=1024 '16384 
 Dim objFileSystem, objFile, objStream 
 Dim char 
 Dim sent 
 Set objFileSystem = CreateObject("Scripting.FileSystemObject") 
 If objFileSystem.FileExists(fileSpec)=false Then 
 response.write("<Script>alert(""请求文件不存在！"");history.back();</script>") 
 Exit Function 
 End If 
 FileName = objFileSystem.GetFileName(FileSpec) 
 send=0 
 TransferFile = True 
 Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject") 
 Set objFile = objFileSystem.GetFile(FileSpec) 
 Set objStream = objFile.OpenAsTextStream(ForReading, TristateTrue) 
 Response.AddHeader "content-type", "application/octet-stream" 
 Response.AddHeader "Content-Disposition","attachment;filename=" & filename 
  
 Response.AddHeader "content-length", objFile.Size 
 Do While Not objStream.AtEndOfStream 
 char = objStream.Read(1) 
 Response.BinaryWrite(char) 
 sent = sent + 1 
 If (sent MOD FILE_TRANSFER_SIZE) = 0 Then 
 Response.Flush 
 If Not Response.IsClientConnected Then 
 TransferFile = False 
 Exit Do 
 End If 
 End If 
 Loop 
 Response.Flush 
 If Not Response.IsClientConnected Then TransferFile = False 
 objStream.Close 
 Set objStream = Nothing 
 Set objFileSystem = Nothing 
End Function 
fileSpec =Lcase(Cstr(Trim(Request("fileSpec")))) 
 downLoadFile(fileSpec) 
%>