Mar
5

ASP查询SQL数据并将结果导出到excel     2009

 17:46    1362    0   noel 程序 代码 源码 不指定 | |
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

作者:noel@淘宝网女装新款秋装连衣裙裤子外套上衣_2012时尚女装新款 Ecmall二次开发-PHP技术
地址:http://www.laohucheng.com/post/89/
版权所有©转载时必须以链接形式注明作者和原始出处及本声明!

Tags: , 引用(0)
发表评论
昵称 [注册]
密码 游客无需密码
网址
电邮
打开HTML 打开UBB 打开表情 隐藏 记住我