excel| Data | Database clsexport2excel.asp
<%
' Class begins
Class Clsexport2excel
' Declare constants, variables
Private Strfilepath,strtitle,strsql,strfield,strrows,strcols
Private Strcn,strhtml,strpath
Private Objdbcn,objrs
Private Objxlsapp,objxlsworkbook,objxlsworksheet
Private Arrfield
' Initialize class
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 = "Query Results"
Strrows = 2
Strcols = 1
End Sub
' Destroy class
Private Sub Class_Terminate ()
End Sub
' Attribute filepath
Public Property Let FilePath (value)
strFilePath = value
End Property
Public Property Get FilePath ()
FilePath = strFilePath
End Property
' Property title
Public Property Let Title (value)
Strtitle = value
End Property
Public Property Get Title ()
Title = Strtitle
End Property
' Property sql
Public Property Let SQL (value)
strSQL = value
End Property
Public Property Get Sql ()
SQL = strSQL
End Property
' Property field
Public Property Let Field (value)
Strfield = value
End Property
Public Property Get Field ()
Field = Strfield
End Property
' Properties rows
Public Property Let Rows (value)
Strrows = value
End Property
Public Property Get Rows ()
Rows = Strrows
End Property
' Attribute 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 "parameter setting error, please contact the administrator!" Thank
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 = "There is no suitable data export at the moment, if you have any questions, please contact your administrator!" Sorry
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
"' ID card number special handling
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
"Special treatment for employment
ElseIf Objrs.fields (f). Name = "Jiuye" Then
Select Case Objrs.fields (f). Value
Case 1
Objxlsworksheet.cells (c+2,f+1). Value = "Yes"
Case 0
Objxlsworksheet.cells (c+2,f+1). Value = "No"
Case-1
Objxlsworksheet.cells (c+2,f+1). Value = "(unknown)"
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 file has been exported successfully, you can <a href= '" & strFileName & ' target= ' _blank ' > Open </a> File and save file to local directory! "
Objxlsapp.quit
Set Objxlsworksheet = Nothing
Set Objxlsworkbook = Nothing
Set Objxlsapp = Nothing
End If
Objrs.close
Set objRS = Nothing
If err > 0 Then
strHTML = "E
