[代码]ASP导出EXCEL代码

baacloud免费翻墙vpn注册使用

1.需要先本地配置dcomcnfg中的dcom组件execl应用程序权限对everyone开放

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>无标题文档</title>
</head>
<body>
<%
Set xlApplication = Server.Cr&#101;ateObject("Excel.Application") &#39;调用excel对象
xlApplication.Visible = False &#39;无需打开excel
xlApplication.SheetsInNewWorkbook=1 &#39;指定excel中表的数量
xlApplication.Workbooks.Add &#39;添加工作簿
Set xlWorksheet = xlApplication.Worksheets(1)  &#39;生成第1个工作表的子对象
xlWorksheet.name="周报表" &#39;指定工作表名称
&#39;指定列的宽度以及对齐方式
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
&#39;指定列的高度以及特定列
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 &#39;合并列
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
&#39;xlApplication.ActiveSheet.Rows(i).RowHeight = 30
&#39;xlWorksheet.Range(xlWorksheet.Cells(i,3), xlWorksheet.Cells(i,4)).MergeCells =True
&#39;xlWorksheet.Range(xlWorksheet.Cells(i,7), xlWorksheet.Cells(i,8)).MergeCells =True
Set fs = Cr&#101;ateObject("Scripting.FileSystemObject")
tfile=Server.MapPath("test.xls")
if fs.FileExists(tfile) then
Set f = fs.GetFile(tfile)
f.del&#101;te true
Set f = nothing
end if
Set fs = nothing
xlWorksheet.SaveAs tfile &#39;保存文件
xlApplication.Quit &#39;释放对象
Set xlWorksheet = Nothing
Set xlApplication = Nothing
%>
<%
Function downLoadFile(FileSpec)
on error resume next
Const ForReading=1
Const TristateTrue=-1
Const FILE_TRANSFER_SIZE=1024   &#39;16384
Dim objFileSystem, objFile, objStream
Dim char
Dim sent
Set objFileSystem = Cr&#101;ateObject("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.Cr&#101;ateObject("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)
%>
<p align="center"><a href="downfile.asp?fileSpec=<%=tfile%>">下载</a></p>
</body>
</html>
赞(0) 打赏
分享到: 更多 (0)

觉得文章有用就打赏一下文章作者

支付宝扫一扫打赏

微信扫一扫打赏