This version has enhanced a lot than version 1.0, and the same as Access class, you can save more than one file, and you can use files every table, and the method is the same. A method is also added in this release: [obj] .close, this method is to do not want to log out classes, but want to end the class's Excel process.
<% Class databasetoexcel '/ ********************************************************************** ********************************* * Transfer data to the Excel file (backup database class Excel) V2.0 ' / * author: dead in the water fish (dead) '/ * date: August 4, 2004' /*Blog:http://blog.9cbs.com/bpfish'/*'/* statement: use this The class required server is installed with Office (Excel), otherwise it may not be able to transfer data '/ * this version of this version to support a multi-data table, or place each data table as a file,' / * use The method is to replace the TargetFile parameter value before the Transfer table can be '/ * usage:' / * method 1: (Access database file to excel database file) '/ * 1, first set the source database file SourceFile (optional) and target database Document TargetFile, use Transfer ("Source Table", "Target Table Name", Field List, Transfer Conditions) Method Transfer Data '/ * Example:' / * DIM SFile , TFile, Objclass, SResult '/ * sfile = server.mappath ("DATA / DATA.MDB")' / * tfile = server.mappath (".") & "/ back.xls" '/ * set objclass = new DatabaseToexcel '/ * objclass.sourcefile = sfile' / * objclass.targetfile = tfile '/ * SResult = Objclass.Transfer ("Table1", "Table 1", "," ")' / * if SResult Then '/ * Response.write "Transfer Data Success!" '/ * Else' / * response.write "Transfer Data Failed!" '/ * End if' / * set objclass = Nothing '/ *' / * Method 2: (Other Database Files To Excel Database File) '/ * 1, set the target database file TargetFile' / * 2, set the Adodb.Connection object '/ * 3, use Transfer ("Source Table Name", "Target Table Name", Field List, Transfer Conditions "method Transfer Data '/ * example: (Use Access data source to do case, you can Use other data sources) '/ * DIM CONN, CONNSTR, TFILE, OBJCLASS, SRESULT' / * TFILE = Server.MAPPATH (".") & "/ Back.xls" '/ * set conn = server.createObject ("
Adodb.connection ") '/ * connStr =" provider = microsoft.jet.oledb.4.0; data source = "& Server.mappath (" data / data.mdb ")' / * conn.open connStr '/ * set objclass = New DatabaseToExcel '/ * set objclass.conn = conn' The key '/ * objclass.targetfile = tfile' / * sResult = Objclass.transfer ("Table1", "Table 1", "," ") '/ * If SResult Ten '/ * response.write "Transfer Data is successful! "'/ * Else' / * response.write" transfer data failed! "'/ * End if' / * set objclass = Nothing '/ * conn.close' / * set conn = Nothing '/ *' / * Description: TargetFile property must be set! (Backup file address, absolute address!) ' / * If you do not set SourceFile, you must set up CONN, which must be one of these two properties, but the priority is a conn '/ * method: Transfer ("Source Data Table Name," Target Data Table Name, "Field List "," Transfer Condition ") '/ *" field list; Transfer condition "Format" Field List "," Query Condition "format The same' / *" field list "is all fields," Query Condition " Get all data '/ * This version adds a method close, this method is to use' / ************************************************************* *********************************************************** *************** Private S_Connprivate Objexcelapp, ObjexcelSheet, ObjectcelBookPrivate Schar, Endchar, Isheet '/ ******************************* *********************************************************** **** '/ * Global Variable' / * External Direct Use: [OBJ]. SourceFile = Source File Name '/ ******************************* *********************************************************** ** Public SourceFilePrivate S_TargetFile
Private Sub Class_Initialize sChar = "ABCDEFGHIJKLNMOPQRSTUVWXYZ" objExcelApp = Null s_Conn = Null iSheet = 1 'mark Excel worksheet current activity (initial range 1--3) End SubPrivate Sub Class_Terminate If IsObject (s_Conn) And Not IsNull (s_Conn) THEN S_CONN.CLOSE SET S_CONN = Nothing end if closeexcelend sub '/ ****************************************************** ******************************************* Setting / Return Conn object '/ * Description: Add this is set for other databases (such as: MSSQL) to the data transfer of the Excel database, '/ ************************************************ *********************************************** Public Property Set Conn (sNewValue) If Not IsObject (sNewValue) Then s_Conn = Null Else Set s_Conn = sNewValue End IfEnd PropertyPublic Property Get Conn If IsObject (s_Conn) Then Set Conn = s_Conn Else s_Conn = Null End IfEnd Property
'/ ********************************************************** *************************** / * Settings / Return Target Object '/ * Description: When changing TargetFile, doing mobile data before Save '/ ************************************************************************ ************************************** PUBLIC Property Let TargetFile (SNewValue) If Ucase (SNEWVALUE) <> ucase (s_targetfile) Then ' change the file, close the previous Excel process CloseExcel End if s_TargetFile = sNewValueEnd PropertyPublic Property Set TargetFile (sNewValue) if UCase (sNewValue) <> UCase (s_TargetFile) then 'change the file, close the previous Excel process CloseExcel End if s_TargetFile = sNewValueEnd PropertyPublic Property Get TargetFile TargetFile = S_TargetFileEnd Property
'/ ********************************************************** ************************************* '/ * Data Transfer' / * Function Function: Transfer Source Data to TargetFile Database File '/ * Function Description : Transfer the SQL statement SELECT INTO IN method Transfer '/ * function Returns: Return to some status code true = Transfer data success false = Transfer data failed' / * function parameters: stablename = source database table name '/ * scol = To transfer The field list of data, the format is the same with the field list format of SELECT. The condition when transferring data is the same as the WHERE of the SQL statement '/ *************** *********************************************************** ********** Public Function Transfer (Stablename, Ttablename, Scol, SSQL) On Error ResMe nextddim SQL, RSDIM IFIELDSCOUNT, IMOD, IIMOD, ICOUNT, IF S_TARGETFILE = "" The 'does not have a target saved file, Transfer failure TRANSFER = false exit function end if if stablename = "" THEN 'has no data sheet, transfer failed TRANSFER = false exit function end if if Ttablename = "" "no target table name Using the source table TTABLENAME = Stablename End ififf NOT INTCONN THEN 'If you don't initialize the conn object, transfer data error = false exit function end if if not createsheet (ttablename) Then' If you cannot initialize the Excel object does not activate the Sheet worksheet, transfer data error TRANSFER = FALSE EXIT FUNCTION END IF EXSQL <> "" THEN 'Condition Query SSQL = "WHERE" & SSQL END IF SCOL = "" The' "list,", "Separate SCOL =" * "end if set = Server.createObject ("AdoDb.Recordset") SQL = "SELECT" & SCOL & "From [" & stablename & "]" & ssql ropen sql, s_conn, 1,1 if err.Number <> 0 THEN 'error, transfer data error, Otherwise transfer data success err.clear transfeer =
False Set Rs = Nothing Exit Function End If IFIELDSCOUNT = rs.fields.count 'Did you have no fields and no records exit if Ifieldscount <1 or or.eof kil = false set = Nothing exit function end if' gets the end of the cell letter iMod = iFieldsCount Mod 26 iCount = iFieldsCount / 26 If iMod = 0 Then iMod = 26 iCount = iCount End If EndChar = "" Do While iCount> 0 iiMod = iCount Mod 26 iCount = iCount / 26 If iiMod = 0 Then iiMod = 26 iCount = iCount end if endchar = mid (Schar, IIMOD, 1) & endchar loop endchar = endchar & mid (schar, iMOD, 1) DIM SEXE 'Run string
'Field name list i = 1 sexe = "Objexcelsheet.Range (" "A" & I & ":" & Endchar & I & ""). Value = array ("for imod = 0 to ifieldscount-1 sexe = sexe &" "" "" Fields (imod) .name if imod = ifieldscount-1 Then sexe = sexe & "" Else Sexe = sexe & "" END IF NEXT EXECUTE SEXE 'Writing Name If Err.Number <> 0 THEN' Error Transfer data error, otherwise transfer data success err.clear transfert = false rsclose set = nothing exit function end if i = 2 do uns.eof sexe = "Objexcelsheet.Range (" & I & I & I & I: "& Endchar & I & I & I & I & I "") .Value = array ("for imod = 0 to ifieldscount-1 sexe = sexe &" "" & = sexe & ")" "" "" "" "" "" "" Sexe & "" "" End if Next Execute SEXE 'Write the i = i 1 .movenext loop if err.number <> 0 THEN' error, transfer data error, otherwise transfer data success err.clear transfeer = False rs.close set = Nothing exit function end if 'saves file if isheet = 1 Then' The first workpiece is saved as file ObjexcelBook.saveas s_targetf Ile else ObjexcelBook.save 'Other Worksheet Direct Save End if if Err.Number <> 0 THEN' Error Transfer Data Error, otherwise Transfer Data Success Err.clear Transfer = False Rs.Close Set RS = Nothing EXIT FUNCTION END IF RS .Close set = Nothing isheet = isheet 1 'new Excel worksheet Transfer =
Truend function '/ ************************************************************* **************************** / * Turn off the Excel process and save the data '/ *' / ***** *********************************************************** ******************* Public Sub Close CloseExcelend Sub
'/ ********************************************************** *************************** / * Initializing Excel Component Object '/ *' / ********** *********************************************************** ************** Private Function InitExcel () On Error Resume Next If Not IsObject (objExcelApp) Then Set objExcelApp = Server.CreateObject ( "Excel.Application") objExcelApp.DisplayAlerts = False objExcelApp. Application.Visible = False objExcelApp.WorkBooks.add Set objExcelBook = objExcelApp.ActiveWorkBook If Err.Number <> 0 Then CloseExcel InitExcel = False Err.Clear Exit Function End If End If InitExcel = TrueEnd FunctionPrivate Function createSheet (sName) 'establishment of Excel Sheet and activate if notinitexcel kilns createsheet = false exit function end if on error resume next if isheet <= 3 TEN 'If the ISHEET value is still 1,2,3 does not have to create a new worksheet, Excel has three table set Objexcelsheet = Objexcelbook.sheets (isheet) else set objexcelsheet = ObjexcelBook.sheets.add end a jXcelsheet.n AME = sname if err.number <> 0 THEN CREATESHEET = false exit function end if createesheet = truend function
Private Sub CloseExcel () On Error Resume Next If IsObject (objExcelApp) Then objExcelApp.Quit Set objExcelSheet = Nothing Set objExcelBook = Nothing Set objExcelApp = Nothing End If ObjExcelApp = Null iSheet = 1End Sub '/ ********* *********************************************************** **************** '/ * Initialize AdoDb.Connection Component Object' / * '/ ******************* *********************************************************** ***** Private Function InitConn () On Error Resume NextDim ConnStr If Not IsObject (s_Conn) Or IsNull (s_Conn) Then If SourceFile = "" Then InitConn = False Exit Function Else Set s_Conn = Server.CreateObject ( "ADODB.Connection ") Connstr =" provider = microsoft.jet.Oledb.4.0; data source = "& sourcefile s_conn.open connStr if err.number <> 0 Then initconn = false err.clear s_conn = null exit function end if end if endiff INITCONN = TrueEnd Functionend Class%>
