<% Class databasetoexcel '/ ********************************************************************** ******************************** / * transfer data to the Excel file (backup database class Excel) v1.0 ' / * author: dead in the water fish (dead) '/ * date: August 4, 2004' /*Blog:http://blog.9cbs.net/bpfish'/*'/* statement: use this The class required server is installed on the Office (Excel) program, otherwise it may not be able to transfer data '/ * This version of this version is only supported to convert a data table, ie a data table can only correspond to an Excel file.
'/ * If you do not replace the TargetFile parameter after converting a data table, you will overwrite the previous table data! ! ! ! '/ * Usage:' / * Method 1: (Access Database file to Excel Database file) '/ * 1, first set the source database file Sourcefile (optional) and target database file TargetFile (required)' / * 2, then Transfer data '/ * example:' / * DIM SFILE, TFILE, OBJCLASS, SRESULT '/ * SFILE = Server.MAppath ("DATA / Data.mdb ") '/ * tfile = server.mappath (". ") &" / back.xls "' / * set objclass = new databaseEtoexcel '/ * objclass.sourcefile = sfile' / * objclass.targetfile = tfile ' / * SResult = Objclass.Transfer ("Table1", "" "" "" "" "" '/ * else' / * response.write "transfer data failed!" '/ * Else' / * response.write ! "'/ * 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", "Field List", Transfer Conditions) Method Transfer Data' / * Example: (Use Access data source to do an example, you can use it Data Source) '/ * DIM Conn, Conn, 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 Databaseetoe Xcel '/ * set objclass.conn = conn' The key '/ * objclass.targetfile = tfile' / * sResult = Objclass.Transfer ("Table1", "," ") '/ * if SResult Ten'
/ * Response.write "transfer data success!" '/ * 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 Name", "Field List", "Transfer Condition") '/ * "field list; Transfer condition" Format "Field List", "Query Condition" format The same' / * "field list" is all fields, " Query conditions "Get all data '/ ********************************************************************** ********************************************* Private S_Connprivate Objexcelapp, ObjexcelSheet, ObjexcelBookPrivate Schar, Endchar '/ ** *********************************************************** ************************ / * Global variable '/ * External direct use: [OBJ]. SourceFile = source file name [obj] .targetfile = Target file name '/ ************************************************************* ****************************** Public SourceFile, TargetFilePrivate Sub Class_Initialize sChar = "ABCDEFGHIJKLNMOPQRSTUVWXYZ" objExcelApp = Null s_Conn = NullEnd 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
'/ ********************************************************** *************************** '/ * Settings / Return Conn Object' / * Description: Add this is for other databases (such as: MSSQL ) To the data transfer of the Access 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 ISOBJECT (S_CONN) THEN SET CONN = S_CONN ELSE S_CONN = NULL END IFEND 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, SCOL, SSQL) On Error ResMe nextddim SQL, RSDIM IFIELDSCOUNT, IMOD, IIMOD, ICOUNT, IX TARGETFILE = "" "No target saved file, transfer failed TRANSFER = false exit function end if if not initconn dam, if the conn object is not initialized, the transfer data error = false exit function end if if not initexcel dam, if the Excel object is not initialized Transfer = false exit function end ififf SSQL <> "" "Condition Query SSQL =" WHERE "& SSQL End If IF SCOL =" "The '" list, "," Separate scol = "*" end if set = server.cr EateObject ("AdoDb.Recordset") SQL = "SELECT" & SCOL & "From [" & stablename "& SSQL RS.Open SQL, S_CONN, 1, 1 if err.Number <> 0 THEN 'error, transfer data error, otherwise transfer data successfully Err.Clear Transfer = False Set Rs = Nothing CloseExcel exit Function End if iFieldsCount = rs.Fields.Count 'field and did not record exit if iFieldsCount <1 Or rs.Eof then Transfer = False Set Rs = Nothing CloseExcel exit Function endiff
Obtaining the cell ends with the 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 = nothing closeexcel exit function end if i = 2 do until = "Objexcelsheet.Range (" A "& I & I & I:" & Endchar & I & I & I & I & I "" ") .Value = array (" for imod = 0 to ifieldscount-1 sexe = sexe & "" "" & = sexe & "Else 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 Transfer = False rs.close set = nothing closeexcel exit function endiffelbook.saveas targetfile if err.number <> 0 th EN 'error, transfer data error, otherwise transfer data success err.clear transfert = nothing closeexcel exit function end if rs.close set = Nothing CloseExcel Transfer = TrueEnd Function
'/ ********************************************************** *************************** / * Initializing Excel Component Object '/ *' / ********** *********************************************************** ************** Private Function InitExcel () On Error Resume Next If Not IsObject (objExcelApp) Or IsNull (objExcelApp) Then Set objExcelApp = Server.CreateObject ( "Excel.Application") objExcelApp. DisplayAlerts = False objExcelApp.Application.Visible = False objExcelApp.WorkBooks.add Set objExcelBook = objExcelApp.ActiveWorkBook set objExcelSheet = objExcelBook.Sheets (1) If Err.Number <> 0 Then CloseExcel InitExcel = False Err.Clear Exit Function End If End If InitExcel = TrueEnd FunctionPrivate Sub CloseExcelOn Error Resume Next If IsObject (objExcelApp) Then objExcelApp.Quit Set objExcelSheet = Nothing Set objExcelBook = Nothing Set objExcelApp = Nothing End If objExcelApp = NullEnd Sub
