query_to_xls.asp

关于设备管理的大型系统

<!--#include file="user_timeout.asp"-->
<!--#include file="getabcd.asp"-->
<%
query_time=request("query_time")
taxis=request("taxis")
if query_time="" then
	query_time=year(now())
end if
if taxis="" then
	taxis="zheng"
end if
if query_time="全部" then
	if taxis="zheng" then
		sql="select * from contract order by c_no"
	else
		sql="select * from contract order by c_no desc"
	end if
else
	if taxis="zheng" then
		sql="select * from contract where create_time between #"&query_time&"-1-1 00:00:00# and #"&query_time&"-12-31 23:59:59# order by c_no"
	else
		sql="select * from contract where create_time between #"&query_time&"-1-1 00:00:00# and #"&query_time&"-12-31 23:59:59# order by c_no desc"
	end if
end if
'response.write sql
rs.open sql,conn,1,1

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=10 
xlApplication.ActiveSheet.Columns(1).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(2).ColumnWidth=40
xlApplication.ActiveSheet.Columns(2).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(3).ColumnWidth=18
xlApplication.ActiveSheet.Columns(3).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(4).ColumnWidth=18
xlApplication.ActiveSheet.Columns(4).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(5).ColumnWidth=18
xlApplication.ActiveSheet.Columns(5).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(6).ColumnWidth=18
xlApplication.ActiveSheet.Columns(6).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(7).ColumnWidth=18
xlApplication.ActiveSheet.Columns(7).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(8).ColumnWidth=18
xlApplication.ActiveSheet.Columns(8).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(9).ColumnWidth=18
xlApplication.ActiveSheet.Columns(9).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(10).ColumnWidth=10
xlApplication.ActiveSheet.Columns(10).HorizontalAlignment=3
'xlApplication.ActiveSheet.Rows(i).RowHeight = 30'行的高度
'指定列的高度以及特定列
xlWorksheet.Range(xlWorksheet.Cells(1,1), xlWorksheet.Cells(1,10)).MergeCells =True '合并列
xlWorksheet.Range("A1").value="北华航天工业学院 "&query_time&"年设备合同一览表"
xlWorksheet.Range("A1").font.Size=16'字体大小
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.Cells(2,7).Value = "批首款时间"
xlWorksheet.Cells(2,8).Value = "尾款"
xlWorksheet.Cells(2,9).Value = "批尾款时间"
xlWorksheet.Cells(2,10).Value = "合同状态"

xlWorksheet.Range("A2:J"&rs.recordcount+2).Borders.LineStyle=1
for i=1 to rs.recordcount
	if rs("c_state")="new" then
		c_state="未审核"
	end if
	if rs("c_state")="audited" then
		c_state="已审核"
	end if
	if rs("c_state")="f_passed" then
		c_state="已批首款"
	end if
	if rs("c_state")="l_passed" then
		c_state="已批尾款"
	end if
	xlWorksheet.Cells(2+i,1).Value = rs("c_no")
	xlWorksheet.Cells(2+i,2).Value = rs("c_content")
	xlWorksheet.Cells(2+i,3).Value = FormatCurrency(rs("c_total"))
	xlWorksheet.Cells(2+i,4).Value = cstr(rs("create_time"))
	xlWorksheet.Cells(2+i,5).Value = cstr(rs("audit_time"))
	xlWorksheet.Cells(2+i,6).Value = FormatCurrency(rs("first_payment"))
	xlWorksheet.Cells(2+i,7).Value = cstr(rs("firstpay_time"))
	xlWorksheet.Cells(2+i,8).Value = FormatCurrency(rs("last_payment"))
	xlWorksheet.Cells(2+i,9).Value = cstr(rs("lastpay_time"))  
	xlWorksheet.Cells(2+i,10).Value = c_state
	rs.movenext
next
xlWorksheet.Range(xlWorksheet.Cells(4+rs.recordcount,9), xlWorksheet.Cells(4+rs.recordcount,10)).MergeCells =True '合并列
'xlWorksheet.Cells(4+rs.recordcount,8).Value = "制表日期："
xlWorksheet.Cells(4+rs.recordcount,9).Value = now()
call DBConnEnd()
Set fs = CreateObject("Scripting.FileSystemObject")
tfile=Server.MapPath("nciae_contract_"&query_time&".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("<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(tfile)
%>