asp導出EXCEL格式資料

asp導出EXCEL格式資料
[ 2007/4/10 下午 10:03:00 | By: ㄚ風 ]

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="統計" '指定工作表名稱
'指定列的寬度以及對齊方式
xlApplication.ActiveSheet.Columns(1).ColumnWidth=5
xlApplication.ActiveSheet.Columns(1).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(2).ColumnWidth=40
xlApplication.ActiveSheet.Columns(2).HorizontalAlignment=1
xlApplication.ActiveSheet.Columns(3).ColumnWidth=5
xlApplication.ActiveSheet.Columns(3).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(4).ColumnWidth=15
xlApplication.ActiveSheet.Columns(4).HorizontalAlignment=1
xlApplication.ActiveSheet.Columns(5).ColumnWidth=12
xlApplication.ActiveSheet.Columns(5).HorizontalAlignment=1
xlApplication.ActiveSheet.Columns(6).ColumnWidth=12
xlApplication.ActiveSheet.Columns(6).HorizontalAlignment=3
'xlApplication.ActiveSheet.Rows(i).RowHeight = 30'行的高度
'指定列的高度以及特定列
xlWorksheet.Range(xlWorksheet.Cells(1,1), xlWorksheet.Cells(1,6)).MergeCells =True '合併列
xlWorksheet.Range("A1").value="/oblog4/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.Cells(2,4).Value = "部門"
xlWorksheet.Cells(2,5).Value = "作者"
xlWorksheet.Cells(2,6).Value = "時間"

xlWorksheet.Range("A2:F2").Borders.LineStyle=1

'--------------------------------------------------自己可做迴圈i=i+1（資料庫資料）
'xlWorksheet.Cells(2+i,1).Value = i
'xlWorksheet.Cells(2+i,2).Value = topic
'xlWorksheet.Cells(2+i,3).Value = img_str
'xlWorksheet.Cells(2+i,4).Value = nfrom
'xlWorksheet.Cells(2+i,5).Value = writer
'xlWorksheet.Cells(2+i,6).Value = ntime
'--------------------------------------------------
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


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("")
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)






reference:http://163.21.20.125/oblog4/u/fong/680.html