ASP查询SQL数据并将结果导出到excel
FSO 方法
<%
dim s,sql,filename,fs,myfile,x
Set fs = server.CreateObject("scripting.filesystemobject")
'--假设你想让生成的EXCEL文件做如下的存放
filename = Server.MapPath("order.xls")
'--如果原来的EXCEL文件存在的话删除它
if fs.FileExists(filename) then
fs.DeleteFile(filename)
end if
'--创建EXCEL文件
set myfile = fs.CreateTextFile(filename,true)
'Set rs = Server.CreateObject("ADODB.Recordset")
'--从数据库中把你想放到EXCEL中的数据查出来
'sql = "select * from Tb_Execl order by id desc"
'rs.Open sql,conn
StartTime = Request("StartTime")
EndTime = Request("EndTime")
StartEndTime = "AddTime between #"& StartTime &" 00:00:00# and #"& EndTime &" 23:59:59#"
'strSql = "select * from survery_custom "
search=request("search")
'set rs=server.createobject("adodb.recordset")
strSql="select * from survery_custom"
if search=1 then
strSql=strSql & " where type like '%"&Trim(request("txtitle"))&"%'"
ElseIf search=2 then
strSql=strSql & " where nfrom like '%"&Trim(request("txtitle"))&"%'"
end If
strSql=strSql & " order by id desc"
Set rstData =conn.execute(strSql)
if not rstData.EOF and not rstData.BOF then
dim trLine,responsestr
strLine=""
For each x in rstData.fields
strLine = strLine & x.name & chr(9)
Next
'--将表的列名先写入EXCEL
myfile.writeline strLine
Do while Not rstData.EOF
strLine=""
for each x in rstData.Fields
strLine = strLine & x.value & chr(9)
next
myfile.writeline strLine
rstData.MoveNext
loop
end if
Response.Write "生成EXCEL文件成功,点击 <a href=""order.xls"" target=""_blank""> <font color=blue>下载 </a> </a>!"
rstData.Close
set rstData = Nothing
sql=strSql
%>
制作一个页面,页面的内容是你要导出来的信息,页面可以动态的(里面有代码),然后在页面前部加上这个导出代码。。。。就可以导出了
<%
Response.Buffer = TRUE
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader "content-disposition", "inline; filename = 用户信息.xls"
%>
思路:用一个专门的EXCEL文件生成类,这个类只需要提供标准查询语句就可以生成表,然后你把显示的记录前面加一个复选框,选中值为每条记录的ID,选中后提交就根据这些ID值生成查询SQL语句,在用EXCEL文件生成类生成EXCEL文件,我附一个EXCEL文件生成类给你:
AspToExcel.Class.asp
VBScript code
<%
'类开始
Class Cls_Excel
'声明常量、变量
Private objRs
Private objExcelApp
Private objExcelBook
Private Conn
Private Sql
Private Title
Private FieldName
Private FieldValue
Private FilePath
Private FileName
Private Col
Private Row
'Class_Initialize 类的初始化
Private Sub Class_Initialize()
Row = 1 '设定生成的Excel默认起始行
Col = 1 '设定生成的Excel默认起始列
End Sub
'ReportConn得到数据库连接对象
Public Property Let ReportConn(ByVal objConn)
Set Conn = objConn
End Property
'ReportSql得到SQL字符串
Public Property Let ReportSql(ByVal strSql)
Sql = strSql
End Property
'ReportTitle得到所要生成报表的标题
Public Property Let ReportTitle(ByVal strTitle)
Title = strTitle
End Property
'RsFieldName得到所要生成报表的列名称
Public Property Let RsFieldName(ByVal strName)
FieldName = Split(strName,"||")
End Property
'RsFieldValue得到所要生成报表的列值的数据库标识字段
Public Property Let RsFieldValue(ByVal strValue)
FieldValue = Split(strValue,"||")
End Property
'SaveFilePath得到Excel报表的保存路径
Public Property Let SaveFilePath(ByVal strFilePath)
FilePath = strFilePath
End Property
'SaveFileName得到Excel报表的保存文件名
Public Property Let SaveFileName(ByVal strFileName)
FileName = strFileName
End Property
'ColumnOffset得到Excel报表默认起始列
Public Property Let ColumnOffset(ByVal ColOff)
If ColOff > 0 then
Col = ColOff
Else
Col = 1
End If
End Property
'RowOffset得到Excel报表默认起始行
Public Property Let RowOffset(ByVal RowOff)
If RowOff > 0 then
Row = RowOff
Else
Row = 1
End If
End Property
'生成报表
Sub Worksheet()
Dim iCol,iRow,Num
iCol = Col
iRow = Row
Num = 1
Call DBRs()
Call ExcelApp()
Set objExcelBook = objExcelApp.Workbooks.Add
'写Excel标题
'--------------------------------------------------------
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = Title
'--------------------------------------------------------
'写Excel各列名
'--------------------------------------------------------
iRow = Row + 1
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = "序号"
iCol = iCol + 1
For i = 0 to Ubound(FieldName)
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = FieldName(i)
iCol = iCol + 1
Next
'--------------------------------------------------------
'写Excel各列值
'--------------------------------------------------------
iRow = Row + 2
Do While Not objRS.EOF
iCol = Col
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = Num
iCol = iCol + 1
For i = 0 to Ubound(FieldValue)
If IsNull(objRS(FieldValue(i))) then
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = ""
Else
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = objRS(FieldValue(i))
End If
iCol = iCol + 1
Next
objRS.MoveNext
iRow = iRow + 1
Num = Num + 1
Loop
'--------------------------------------------------------
Call SaveWorksheet()
End Sub
'创建Adodb.Recordset对象
Sub DBRs()
If IsObject(objRs) = True Then Exit Sub
Set objRs = Server.CreateObject("Adodb.Recordset")
objRs.Open Sql,Conn,1,1
If Err.Number > 0 Then
Response.End
End If
End Sub
'创建Excel.Application对象
Sub ExcelApp()
If IsObject(objExcelApp) = True Then Exit Sub
Set objExcelApp = Server.CreateObject("Excel.Application")
objExcelApp.DisplayAlerts=false '不显示警告
objExcelApp.Application.Visible=false '不显示界面
If Err.Number > 0 Then
Response.End
End If
End Sub
'保存Excel报表
Sub SaveWorksheet()
objExcelbook.SaveAs Server.MapPath(FilePath) & "\" & FileName & ".xls"
If Err.Number = 0 Then
Call Message("导出数据成功!")
Else
Call Message("导出数据失败!")
End If
End Sub
'信息提示
Sub Message(msg)
Response.Write("<script language='JavaScript'>")
Response.Write("alert('"&msg&"');")
Response.Write("</script>")
Response.Write("<a href='" & FilePath &"/" & FileName & ".xls'>")
Response.Write("点击下载文件</a>")
Response.End
End Sub
'Class_Terminate 类注销
Private Sub Class_Terminate()
objExcelApp.Application.Quit
Set objExcelBook = Nothing
Set objExcelApp = Nothing
objRs.Close
Set objRs = Nothing
End Sub
'类结束
End Class
%>
现附上一个使用示例:
VBScript code
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="conn.asp" -->
<!--#include file="sub.asp" -->
<!--#include file="config/AspToExcel.Class.asp" -->
<html>
<head>
<title>导出Excel</title>
</head>
<body>
<%
'---获取页面参数---
TypeNum=int(Request("TypeNum"))
'---页面参数判断---
select case TypeNum
case 1 '请款资料导出
'---获取参数---
ClientID=Request("ClientID") '结账客户ID
ClientName=Request("ClientName") '结账客户名称
GatherMonth=Request("GatherMonth") '结账月份
OutProductCodeStr=Request("OutProductCodeStr") '结账出货单ID
if ClientID="" or ClientName="" or GatherMonth="" or OutProductCodeStr="" then response.Redirect("Wrong.asp") '判断关键参数不能为空
FolderName="UploadFile\请款资料\"&ClientName '导出文件路径
AutoCreateFolder(FolderName) '检查文件路径是否存在,不存在则创建
FileName=ClientName&GatherMonth&"请款资料" '导出文件名
sql="select 客户订号,日期,出货单号,产品名称,规格,单位,单价,数量,金额,备注 from 出货单库 where ID in ("&OutProductCodeStr&") and 终止=false order by 日期" '数据查询语句
'---Excel文件生成---
Set MyExcel = new Cls_Excel
With MyExcel
.ReportConn = conn
.ReportSql = sql
.ReportTitle = FileName
.RsFieldName = "订购单号||送货日期||送货单号||产品名称||规格||单位||单价||数量||金额||备注"
.RsFieldValue = "客户订号||日期||出货单号||产品名称||规格||单位||单价||数量||金额||备注"
.SaveFilePath = FolderName
.SaveFileName = FileName
.ColumnOffset = 1
.RowOffset = 1
End With
MyExcel.Worksheet()
MyExcel = Null
Set MyExcel = Nothing
end select
%>
</body>
</html>
<% closeDatabase %>
如果需要生成较为复杂的excel 请参考 http://tieba.baidu.com/f?kz=6668708
FSO禁用时,客户端操作 http://hi.baidu.com/yjdzh/blog/item/7443f0a8928f62b5cb130c1d.html
ASP导出Excel数据的四种方法 http://hi.baidu.com/xtalon/blog/item/3cac94ee1c4b39292cf53429.html
FSO 方法
<%
dim s,sql,filename,fs,myfile,x
Set fs = server.CreateObject("scripting.filesystemobject")
'--假设你想让生成的EXCEL文件做如下的存放
filename = Server.MapPath("order.xls")
'--如果原来的EXCEL文件存在的话删除它
if fs.FileExists(filename) then
fs.DeleteFile(filename)
end if
'--创建EXCEL文件
set myfile = fs.CreateTextFile(filename,true)
'Set rs = Server.CreateObject("ADODB.Recordset")
'--从数据库中把你想放到EXCEL中的数据查出来
'sql = "select * from Tb_Execl order by id desc"
'rs.Open sql,conn
StartTime = Request("StartTime")
EndTime = Request("EndTime")
StartEndTime = "AddTime between #"& StartTime &" 00:00:00# and #"& EndTime &" 23:59:59#"
'strSql = "select * from survery_custom "
search=request("search")
'set rs=server.createobject("adodb.recordset")
strSql="select * from survery_custom"
if search=1 then
strSql=strSql & " where type like '%"&Trim(request("txtitle"))&"%'"
ElseIf search=2 then
strSql=strSql & " where nfrom like '%"&Trim(request("txtitle"))&"%'"
end If
strSql=strSql & " order by id desc"
Set rstData =conn.execute(strSql)
if not rstData.EOF and not rstData.BOF then
dim trLine,responsestr
strLine=""
For each x in rstData.fields
strLine = strLine & x.name & chr(9)
Next
'--将表的列名先写入EXCEL
myfile.writeline strLine
Do while Not rstData.EOF
strLine=""
for each x in rstData.Fields
strLine = strLine & x.value & chr(9)
next
myfile.writeline strLine
rstData.MoveNext
loop
end if
Response.Write "生成EXCEL文件成功,点击 <a href=""order.xls"" target=""_blank""> <font color=blue>下载 </a> </a>!"
rstData.Close
set rstData = Nothing
sql=strSql
%>
制作一个页面,页面的内容是你要导出来的信息,页面可以动态的(里面有代码),然后在页面前部加上这个导出代码。。。。就可以导出了
<%
Response.Buffer = TRUE
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader "content-disposition", "inline; filename = 用户信息.xls"
%>
思路:用一个专门的EXCEL文件生成类,这个类只需要提供标准查询语句就可以生成表,然后你把显示的记录前面加一个复选框,选中值为每条记录的ID,选中后提交就根据这些ID值生成查询SQL语句,在用EXCEL文件生成类生成EXCEL文件,我附一个EXCEL文件生成类给你:
AspToExcel.Class.asp
VBScript code
<%
'类开始
Class Cls_Excel
'声明常量、变量
Private objRs
Private objExcelApp
Private objExcelBook
Private Conn
Private Sql
Private Title
Private FieldName
Private FieldValue
Private FilePath
Private FileName
Private Col
Private Row
'Class_Initialize 类的初始化
Private Sub Class_Initialize()
Row = 1 '设定生成的Excel默认起始行
Col = 1 '设定生成的Excel默认起始列
End Sub
'ReportConn得到数据库连接对象
Public Property Let ReportConn(ByVal objConn)
Set Conn = objConn
End Property
'ReportSql得到SQL字符串
Public Property Let ReportSql(ByVal strSql)
Sql = strSql
End Property
'ReportTitle得到所要生成报表的标题
Public Property Let ReportTitle(ByVal strTitle)
Title = strTitle
End Property
'RsFieldName得到所要生成报表的列名称
Public Property Let RsFieldName(ByVal strName)
FieldName = Split(strName,"||")
End Property
'RsFieldValue得到所要生成报表的列值的数据库标识字段
Public Property Let RsFieldValue(ByVal strValue)
FieldValue = Split(strValue,"||")
End Property
'SaveFilePath得到Excel报表的保存路径
Public Property Let SaveFilePath(ByVal strFilePath)
FilePath = strFilePath
End Property
'SaveFileName得到Excel报表的保存文件名
Public Property Let SaveFileName(ByVal strFileName)
FileName = strFileName
End Property
'ColumnOffset得到Excel报表默认起始列
Public Property Let ColumnOffset(ByVal ColOff)
If ColOff > 0 then
Col = ColOff
Else
Col = 1
End If
End Property
'RowOffset得到Excel报表默认起始行
Public Property Let RowOffset(ByVal RowOff)
If RowOff > 0 then
Row = RowOff
Else
Row = 1
End If
End Property
'生成报表
Sub Worksheet()
Dim iCol,iRow,Num
iCol = Col
iRow = Row
Num = 1
Call DBRs()
Call ExcelApp()
Set objExcelBook = objExcelApp.Workbooks.Add
'写Excel标题
'--------------------------------------------------------
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = Title
'--------------------------------------------------------
'写Excel各列名
'--------------------------------------------------------
iRow = Row + 1
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = "序号"
iCol = iCol + 1
For i = 0 to Ubound(FieldName)
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = FieldName(i)
iCol = iCol + 1
Next
'--------------------------------------------------------
'写Excel各列值
'--------------------------------------------------------
iRow = Row + 2
Do While Not objRS.EOF
iCol = Col
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = Num
iCol = iCol + 1
For i = 0 to Ubound(FieldValue)
If IsNull(objRS(FieldValue(i))) then
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = ""
Else
objExcelBook.WorkSheets(1).Cells(iRow,iCol).Value = objRS(FieldValue(i))
End If
iCol = iCol + 1
Next
objRS.MoveNext
iRow = iRow + 1
Num = Num + 1
Loop
'--------------------------------------------------------
Call SaveWorksheet()
End Sub
'创建Adodb.Recordset对象
Sub DBRs()
If IsObject(objRs) = True Then Exit Sub
Set objRs = Server.CreateObject("Adodb.Recordset")
objRs.Open Sql,Conn,1,1
If Err.Number > 0 Then
Response.End
End If
End Sub
'创建Excel.Application对象
Sub ExcelApp()
If IsObject(objExcelApp) = True Then Exit Sub
Set objExcelApp = Server.CreateObject("Excel.Application")
objExcelApp.DisplayAlerts=false '不显示警告
objExcelApp.Application.Visible=false '不显示界面
If Err.Number > 0 Then
Response.End
End If
End Sub
'保存Excel报表
Sub SaveWorksheet()
objExcelbook.SaveAs Server.MapPath(FilePath) & "\" & FileName & ".xls"
If Err.Number = 0 Then
Call Message("导出数据成功!")
Else
Call Message("导出数据失败!")
End If
End Sub
'信息提示
Sub Message(msg)
Response.Write("<script language='JavaScript'>")
Response.Write("alert('"&msg&"');")
Response.Write("</script>")
Response.Write("<a href='" & FilePath &"/" & FileName & ".xls'>")
Response.Write("点击下载文件</a>")
Response.End
End Sub
'Class_Terminate 类注销
Private Sub Class_Terminate()
objExcelApp.Application.Quit
Set objExcelBook = Nothing
Set objExcelApp = Nothing
objRs.Close
Set objRs = Nothing
End Sub
'类结束
End Class
%>
现附上一个使用示例:
VBScript code
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="conn.asp" -->
<!--#include file="sub.asp" -->
<!--#include file="config/AspToExcel.Class.asp" -->
<html>
<head>
<title>导出Excel</title>
</head>
<body>
<%
'---获取页面参数---
TypeNum=int(Request("TypeNum"))
'---页面参数判断---
select case TypeNum
case 1 '请款资料导出
'---获取参数---
ClientID=Request("ClientID") '结账客户ID
ClientName=Request("ClientName") '结账客户名称
GatherMonth=Request("GatherMonth") '结账月份
OutProductCodeStr=Request("OutProductCodeStr") '结账出货单ID
if ClientID="" or ClientName="" or GatherMonth="" or OutProductCodeStr="" then response.Redirect("Wrong.asp") '判断关键参数不能为空
FolderName="UploadFile\请款资料\"&ClientName '导出文件路径
AutoCreateFolder(FolderName) '检查文件路径是否存在,不存在则创建
FileName=ClientName&GatherMonth&"请款资料" '导出文件名
sql="select 客户订号,日期,出货单号,产品名称,规格,单位,单价,数量,金额,备注 from 出货单库 where ID in ("&OutProductCodeStr&") and 终止=false order by 日期" '数据查询语句
'---Excel文件生成---
Set MyExcel = new Cls_Excel
With MyExcel
.ReportConn = conn
.ReportSql = sql
.ReportTitle = FileName
.RsFieldName = "订购单号||送货日期||送货单号||产品名称||规格||单位||单价||数量||金额||备注"
.RsFieldValue = "客户订号||日期||出货单号||产品名称||规格||单位||单价||数量||金额||备注"
.SaveFilePath = FolderName
.SaveFileName = FileName
.ColumnOffset = 1
.RowOffset = 1
End With
MyExcel.Worksheet()
MyExcel = Null
Set MyExcel = Nothing
end select
%>
</body>
</html>
<% closeDatabase %>
如果需要生成较为复杂的excel 请参考 http://tieba.baidu.com/f?kz=6668708
FSO禁用时,客户端操作 http://hi.baidu.com/yjdzh/blog/item/7443f0a8928f62b5cb130c1d.html
ASP导出Excel数据的四种方法 http://hi.baidu.com/xtalon/blog/item/3cac94ee1c4b39292cf53429.html
作者:noel@淘宝网女装新款秋装连衣裙裤子外套上衣_2012时尚女装新款 Ecmall二次开发-PHP技术
地址:http://www.laohucheng.com/post/89/
版权所有©转载时必须以链接形式注明作者和原始出处及本声明!
鼠标移过时背景改变的效果
2009
17:46
1362
0


