[代码]ASP导出EXCEL代码

1.需要先本地配置dcomcnfg中的dcom组件execl应用程序权限对everyone开放
[code]
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>







<% 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=15 xlApplication.ActiveSheet.Columns(1).HorizontalAlignment=3 xlApplication.ActiveSheet.Columns(2).ColumnWidth=20 xlApplication.ActiveSheet.Columns(2).HorizontalAlignment=3 xlApplication.ActiveSheet.Columns(3).ColumnWidth=25 xlApplication.ActiveSheet.Columns(3).HorizontalAlignment=3 xlApplication.ActiveSheet.Columns(4).ColumnWidth=20 xlApplication.ActiveSheet.Columns(4).HorizontalAlignment=3 xlApplication.ActiveSheet.Columns(5).ColumnWidth=15 xlApplication.ActiveSheet.Columns(5).HorizontalAlignment=3 xlApplication.ActiveSheet.Columns(6).ColumnWidth=25 xlApplication.ActiveSheet.Columns(6).HorizontalAlignment=3 xlApplication.ActiveSheet.Columns(7).ColumnWidth=45 xlApplication.ActiveSheet.Columns(7).HorizontalAlignment=3 xlApplication.ActiveSheet.Columns(8).ColumnWidth=20 xlApplication.ActiveSheet.Columns(8).HorizontalAlignment=3 '指定列的高度以及特定列 xlApplication.ActiveSheet.Rows.RowHeight = 20 xlApplication.ActiveSheet.Rows(5).RowHeight = 35 xlApplication.ActiveSheet.Columns("A:H").VerticalAlignment=2 xlWorksheet.Range(xlWorksheet.Cells(2,1), xlWorksheet.Cells(2,8)).MergeCells =True '合并列 xlWorksheet.Range("A2").value="出入境动植物及其产品疫情和有害有毒物质信息统计周报表" xlWorksheet.Range("A2").font.Size=14 xlWorksheet.Range("A2").font.bold=true xlWorksheet.Range(xlWorksheet.Cells(4,1), xlWorksheet.Cells(4,3)).MergeCells =True xlWorksheet.Range(xlWorksheet.Cells(4,6), xlWorksheet.Cells(4,8)).MergeCells =True xlWorksheet.Range("A4").HorizontalAlignment=1 xlWorksheet.Range("A4").VerticalAlignment=2 xlWorksheet.Range("F4").HorizontalAlignment=1 xlWorksheet.Range("F4").VerticalAlignment=2 xlWorksheet.Range("A4").value="填报单位：" xlWorksheet.Range("F4").value="统计时间： "&year(request("begintime"))&"年 "&month(request("begintime"))&"月 "&day(request("begintime"))&"日 至 "&year(request("endtime"))&"年 "&month(request("endtime"))&"月 "&day(request("endtime"))&"日 " xlWorksheet.Cells(5,1).value = "截获口岸" xlWorksheet.Cells(5,2).value = "进出口" xlWorksheet.Cells(5,3).value = "品 名" xlWorksheet.Cells(5,4).value = "数/单位" xlWorksheet.Cells(5,5).value = "批次" xlWorksheet.Cells(5,6).value = "来源国（产地）" xlWorksheet.Cells(5,7).value = "检疫情况" xlWorksheet.Cells(5,8).value = "处理情况" xlWorksheet.Range("A5:H8").Borders.Linestyle=1 'xlApplication.ActiveSheet.Rows(i).RowHeight = 30 'xlWorksheet.Range(xlWorksheet.Cells(i,3), xlWorksheet.Cells(i,4)).MergeCells =True 'xlWorksheet.Range(xlWorksheet.Cells(i,7), xlWorksheet.Cells(i,8)).MergeCells =True 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 %>
<% 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)
%>

下载

[/code]