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