我寫的一個將資料庫資料匯出到EXCEL的類(ASP)

來源:互聯網
上載者:User
excel|資料|資料庫 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 = "E



相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。