随笔-348  评论-598  文章-0  trackbacks-0
因为项目需要,所以从网上找了一个类,但是那个类问题比较多,所以自己修改了一下,增加容错程度,提升一些性能,里面有部分代码是根据我的项目修改的,所以大家在使用的时候自己改一下就可以了。

使用方法:
<%On Error Resume Next%>
<!--#include file="../Include/Constants.Class.asp"-->
<!--#include file="../Include/Config.Class.asp"-->
<!--#include file="../Include/DBControl.Class.asp"-->
<!--#include file="../Include/FunctionLib.Class.asp"-->
<!--#include file="../Include/Manager.Class.asp"-->
<!--#include file="../Include/Export2Excel.Class.asp"-->
<%
Dim Cfg,Db,Flib,Admin,Con,newExcel,url
Set Cfg=New Config
Set Con=New Constants
Set Admin=New Manager
Set Flib=New FunctionLib
Set Db=New DBControl

If session(request.QueryString("sql"))="" or session(request.QueryString("field"))="" Then
    Flib.MessageBox 
"Excel导出页面参数出错!请联系管理员","",0
End If

response.Write 
"导出过程可能需要很长时间,请稍等<br>"
response.Flush()
set newExcel = New Export2Excel
newExcel.FilePath 
= "Excel/"
newExcel.Sql 
= session(request.QueryString("sql"))
newExcel.Field 
= session(request.QueryString("field"))
response.write newExcel.export2Excel()


%
>

类的源代码:
<%
'  使用方法:
'
  set newExcel = New Export2Excel
'
  newExcel.FilePath = "/mail/excel/"----------------------------------路径
'
  newExcel.Sql = "select * from user"-------------------------------查询语句
'
  newExcel.Field = "帐号||姓名||所属部门||"----------------------输出列名
'
  response.write newExcel.export2Excel()
'
类开始
Class Export2Excel
'声明常量、变量
    Private strFilePath,strTitle,strSql,strField,strRows,strCols
    
Private strCn,strHtml,strPath,strServerPath,Filename
    
Private objDbCn,objRs
    
Private objXlsApp,objXlsWorkBook,objXlsWorkSheet
    
Private arrField
    
'初始化类
    Private Sub Class_Initialize()
     
set objDbCn = Db
     strTitle 
= "查询结果"
     strFilePath
="Excel/"
     strRows 
= 2
     strCols 
= 1
    
End Sub
    
'销毁类
    Private Sub Class_Terminate()
    
End Sub
    
'属性FilePath
    Public Property Let FilePath(value)
     strFilePath 
= value
     strServerPath
=strFilePath
    
End Property
    
Public Property Get FilePath()
     FilePath 
= strFilePat
    
End Property
    
'属性Title
    Public Property Let Title(value)
     strTitle 
= value
    
End Property
    
Public Property Get Title()
     Title 
= strTitle
    
End Property
    
'属性Sql
    Public Property Let Sql(value)
     strSql 
= value
    
End Property
    
Public Property Get Sql()
     Sql 
= strSql
    
End Property
    
'属性Field
    Public Property Let Field(value)
     strField 
= value
    
End Property
    
Public Property Get Field()
     Field 
= strField
    
End Property
    
'属性Rows
    Public Property Let Rows(value)
     strRows 
= value
    
End Property
    
Public Property Get Rows()
     Rows 
= strRows
    
End Property
    
'属性Cols
    Public Property Let Cols(value)
     strCols 
= value
    
End Property
    
Public Property Get Cols()
     Cols 
= strCols
    
End Property
    
'
    Public Function export2Excel()
     
if strSql = "" or strField = "" then
      response.write 
"参数设置错误,请与管理员联系!谢谢"
      response.end
     
end if
     
     strFilePath 
= GetFilePath(Server.mappath(strFilePath&"upload.asp"),"\")
     
set objFso = createobject("scripting.filesystemobject")
     
if objFso.FolderExists(strFilePath) = False then
      objFso.Createfolder(strFilePath)
     
end if
     Filename
=cstr(createFileName()) & ".xls"
     strFileName 
= strFilePath & Filename 
     objDbCn.Open()
     
set objRs = objDbCn.execute(strSql)
     
if objRs.EOF And objRs.BOF then
      strHtml 
= "抱歉,暂时没有任何合适的数据导出,如有疑问,请与管理员联系!"
     
else
      
set objXlsApp = server.CreateObject("Excel.Application")
      objXlsApp.Visible 
= false
      objXlsApp.WorkBooks.Add
      
set objXlsWorkBook = objXlsApp.ActiveWorkBook
      
set objXlsWorkSheet = objXlsWorkBook.WorkSheets(1)
      arrField 
= split(strField,"||")
      
      
for f = 0 to Ubound(arrField)
       objXlsWorkSheet.Cells(
1,f+1).Value = arrField(f)
       
'response.Write arrField(f)&" "
      next
      
'response.Write "<br>"
      objRs=objRs.getRows()
      
If instr(Sql,"exportEnterprise ")=0 then
          
for c=0 to ubound(objRs,2)
              
If response.IsClientConnected=false then exit for '数据多导出时间很长,所以需要探测下客户端是否还在连接
              response.Write "正在导出第"&cstr(c+1)&"条<br>"
            response.Flush()
           
for f = 0 to ubound(objRs,1)
                   
If response.IsClientConnected=false then exit for
             objXlsWorkSheet.Cells(c
+2,f+1).Value = trim(Cstr(objRs(f,c)))&VBCR
             
'objXlsWorkSheet.Columns(f+1).ColumnWidth=Len(Cstr(objRs(f,c)))*2
           next
          
next
          
      
Else
            
for c=0 to ubound(objRs,2)
              
If response.IsClientConnected=false then exit for
              response.Write 
"正在导出第"&cstr(c+1)&"条<br>"
            response.Flush()
           
for f = 0 to ubound(objRs,1)
               
If response.IsClientConnected=false then exit for
            
If f<>1 then
             objXlsWorkSheet.Cells(c
+2,f+1).Value = trim(Cstr(objRs(f,c)))&VBCR
             
'objXlsWorkSheet.Columns(f+1).ColumnWidth=Len(Cstr(objRs(f,c)))*2
            Else
             objXlsWorkSheet.Cells(c
+2,f+1).Value = trim(replace(replace(Cstr(objRs(f,c)),"0",""),"|"," "))&VBCR
             
'objXlsWorkSheet.Columns(f+1).ColumnWidth=Len(Cstr(objXlsWorkSheet.Cells(c+2,f+1).Value))*2            
            End If
           
next
          
next
      
End If
      
      
'必不可少,否则会出现错误
      If objFso.fileExists(strFileName)=true then
          objFso.deletefile strFileName
      
End if
        response.Write 
"导出成功!<br>"
        response.Flush()      
  
      objXlsWorkSheet.SaveAs strFileName
      
      strHtml 
= "<script>location.href='" & GetFilePath(Request.ServerVariables("HTTP_REFERER"),"/")&strServerpath&Filename  & "';</script>"
      objXlsApp.Quit
'重要
      set objXlsWorkSheet = nothing
      
set objXlsWorkBook = nothing
      
set objXlsApp = nothing
     
end if
     objDbCn.Close()
     
set objRs = nothing
     
if err > 0 then
      strHtml 
= "系统忙,请稍后重试"
     
end if
     export2Excel 
= strHtml
    
End Function
    
'函数
    Public Function createFileName()
     
If Admin.id<>"" then
          fName
=Admin.id
     
Else
         fName
=now
         fName
=replace(fName,":","")
         fName
=replace(fName,"-","")
         fName
=replace(fName," ","")
     
End If
     createFileName
=fName
    
End Function
        
    
Public function GetFilePath(FullPath,str)
      
If FullPath <> "" Then
        GetFilePath 
= left(FullPath,InStrRev(FullPath, str))
        
Else
        GetFilePath 
= ""
      
End If
    
End function     
    
'Public Function debug(varStr)
    ' response.write varStr
    ' response.end
    'End Function
    '类结束
End Class
%
>



---------------------------------------------------------
专注移动开发

Android, Windows Mobile, iPhone, J2ME, BlackBerry, Symbian
posted on 2007-07-29 16:28 TiGERTiAN 阅读(2199) 评论(8)  编辑  收藏 所属分类: VB/ASP

评论:
# re: asp导出excel用到的类[未登录] 2008-09-17 10:41 | spring
能发个源码给我吗,现在用的这些,<!--#include file="../Include/Constants.Class.asp"-->
<!--#include file="../Include/Config.Class.asp"-->
<!--#include file="../Include/DBControl.Class.asp"-->
<!--#include file="../Include/FunctionLib.Class.asp"-->
<!--#include file="../Include/Manager.Class.asp"-->没有.E-MAIL:djj128@163.com  回复  更多评论
  
# re: asp导出excel用到的类 2008-09-17 12:47 | TiGERTiAN
@spring
这些没什么用的,类的代码是全的。调用代码就是:
set newExcel = New Export2Excel
newExcel.FilePath = "Excel/"
newExcel.Sql = session(request.QueryString("sql"))
newExcel.Field = session(request.QueryString("field"))
response.write newExcel.export2Excel()
其他没有了。  回复  更多评论
  
# re: asp导出excel用到的类 2008-10-21 23:34 | 不太冷
If instr(Sql,"exportEnterprise ")=0 then
exportEnterprise和Sql是什么地方的?我看不明白,把您的代码运行了下,不生成任何文件  回复  更多评论
  
# re: asp导出excel用到的类 2008-10-21 23:56 | TiGERTiAN
@不太冷
这个条件语句是根据我自己的程序需要来的,可以把这个条件限制去掉,稍微修改下就好了  回复  更多评论
  
# re: asp导出excel用到的类 2008-10-22 00:20 | 不太冷
@TiGERTiAN
不知道是否冒犯,我还在调试这个程序,可惜一直未能成功,你能加我QQ吗?
问几个问题,1741821
  回复  更多评论
  
# re: asp导出excel用到的类 2009-02-11 14:45 | lzq
太行了.  回复  更多评论
  
# re: asp导出excel用到的类 2009-02-27 15:08 | asdfdg
使用说明太不明确了,好多地方都要改的
哪里连数据库都不明确  回复  更多评论
  
# re: asp导出excel用到的类 2009-06-11 14:27 | 站长
很好用的站长查询网站 http://www.ngiv.cn
很全的技术论文 http://bbs.ngiv.cn  回复  更多评论
  

只有注册用户登录后才能发表评论。


网站导航: