asp导出Excel文档代码

xls.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="统计" ’指定工作表名称

’指定列的宽度以及对齐方式

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="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

%>

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

%>