我写的一个将数据库数据导出到EXCEL的类(ASP)

类别:Asp 点击:0 评论:0 推荐:

clsExport2Excel.asp
<%
'类开始
Class clsExport2Excel

'声明常量、变量
Private strFilePath,strTitle,strSql,strField,strRows,strCols
Private strCn,strHtml,strPath
Private objDbCn,objRs
Private objXlsApp,objXlsWorkBook,objXlsWorkSheet
Private arrField

'初始化类
Private Sub Class_Initialize()
 strCn = "driver={SQL Server};server=LIUHQ;UID=sa;PWD=sa;Database=MS"
 set objDbCn = server.CreateObject("adodb.connection")
 objDbCn.open strCn

 strFilePath = ".\"
 strTitle = "查询结果"
 strRows = 2
 strCols = 1
End Sub

'销毁类
Private Sub Class_Terminate()

End Sub

'属性FilePath
Public Property Let FilePath(value)
 strFilePath = value
End Property

Public Property Get FilePath()
 FilePath = strFilePath
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
 
 if right(strFilePath,1) = "/" or right(strFilePath,1) = "\" then
  strFilePath = left(strFilePath,len(strFilePath)-1)
 end if
 if instr("/",strFilePath) > 0 then
  strFilePath = replace(strFilePath,"/","\")
 end if
 strFilePath = strFilePath & "\"

 set objFso = createobject("scripting.filesystemobject")
 if objFso.FolderExists(server.mappath(strFilePath)) = False then
  objFso.Createfolder(server.mappath(strFilePath))
 end if

 strFileName = strFilePath & cstr(createFileName()) & ".xls"

 set objRs = server.CreateObject("adodb.RecordSet")
 objRs.open strSql,objDbCn,3,3
 if objRs.recordcount <= 0 then
  strHtml = "暂时没有任何合适的数据导出,如有疑问,请与管理员联系!抱歉"
 else
  set objXlsApp = server.CreateObject("Excel.Application")
  objXlsApp.Visible = false
  objXlsApp.WorkBooks.Add

  set objXlsWorkBook = objXlsApp.ActiveWorkBook
  set objXlsWorkSheet = objXlsWorkBook.WorkSheets(1)

  objXlsWorkSheet.Cells(1,1).Value = strTitle

  arrField = split(strField,"||")
  for f = 0 to Ubound(arrField)
   objXlsWorkSheet.Cells(2,f+1).Value = arrField(f)
  next

  for c = 1 to objRs.recordcount
   for f = 0 to objRs.fields.count - 1
    '''身份证号码特殊处理
    if objRs.fields(f).name = "pm_field_41325" or objRs.fields(f).name = "cardID" then
     objXlsWorkSheet.Cells(c+2,f+1).Value = "'" & objRs.fields(f).value
    '''就业特殊处理
    elseif objRs.fields(f).name = "JiuYe" then
     select case objRs.fields(f).value
      case 1
       objXlsWorkSheet.Cells(c+2,f+1).Value = "是"
      case 0
       objXlsWorkSheet.Cells(c+2,f+1).Value = "否"
      case -1
       objXlsWorkSheet.Cells(c+2,f+1).Value = "(未知)"
     end select
    else
     objXlsWorkSheet.Cells(c+2,f+1).Value = objRs.fields(f).value
    end if
   next
   objRs.movenext
  next

  objXlsWorkSheet.SaveAs server.mappath(strFileName)

  strHtml = "Excel文件已经导出成功,您可以<a href='" & strFileName & "' target='_blank'>打开</a>文件并将文件另存到本地目录中!"

  objXlsApp.Quit
  set objXlsWorkSheet = nothing
  set objXlsWorkBook = nothing
  set objXlsApp = nothing
 end if
 objRs.close
 set objRs = nothing

 if err > 0 then
  strHtml = "Excel文件导出时出现意外错误,请<a href='#' onclick='window.history.back();'>返回</a>,如有疑问,请与管理员联系!抱歉"
 end if

 export2Excel = strHtml
End Function

'函数
Public Function createFileName()
 fName=now
 fName=replace(fName,":","")
 fName=replace(fName,"-","")
 fName=replace(fName," ","")
 createFileName=fName
End Function

'Public Function debug(varStr)
' response.write varStr
' response.end
'End Function

'类结束
End Class
%>


tesp.asp
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="clsExport2Excel.asp"-->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>无标题文档</title>
</head>

<body>
<%
 set newExcel = New clsExport2Excel
 newExcel.FilePath = "../excel/"
 newExcel.Sql = "select name,cardID from usrPopulation"
 newExcel.Title = "基本人口信息"
 newExcel.Field = "姓名||身份证号||"
 
 response.write newExcel.export2Excel()
%>


</body>
</html>

本文地址:http://com.8s8s.com/it/it7660.htm