Database backup converted to Excel file class

Note: This version of the class only supports converting one data table at a time, that is, a datasheet can only correspond to one Excel file. If you convert a data table without replacing the targetfile parameter, the previous table data will be overwritten!!!!

Use the method please read the note below carefully!!

<%
Class Databasetoexcel
''/***************************************************************************
"/* transfer data to Excel file (Backup database class Excel) V1.0
"* * Author: Dead Fish in the water (dead fish)
' * * Date: August 4, 2004
"/*blog:http://blog.lznews.cn/blog.asp?name=-wah Fish
''/*
'/* Declaration: Use this type of required server to install Office (Excel) programs, or you may not be able to transfer data when used
"* * This version of the class temporarily supports only one data table at a time, that is, a datasheet can only correspond to one Excel file.
'/* If you convert a datasheet without replacing the TargetFile parameter, the previous table data will be overwritten!!!!
'/* Usage:
'/* Method one: (Access database file to Excel database file)
'/*1, first set the source database file SourceFile (optional) and target database file TargetFile (required)
'/*2, and then using transfer (source table name, field list, transfer criteria) method to 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", "" "," ")
'/* If sresult Then
'/* response.write ' Transfer data Success! "
"/* Else
'/* response.write ' Transfer data failed! "
'/* End If
'/* Set objclass=nothing
''/*
"/* Method two: (Other database files to Excel database files)
'/*1, setting the target database file TargetFile
'/*2, setting Adodb.connection object
'/*3, and then using transfer (source table name, field list, transfer criteria) method to transfer data
"* * Example: (using Access's data source for example, 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 ' key here
' * * objclass.targetfile=tfile
' * * Sresult=objclass.transfer ("table1", "" "," ")
'/* If sresult Then
'/* 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 the conn, these two properties must be selected, but the priority is Conn
'/* Method: Transfer ("Source data table name", "Field List", "Transfer condition")
'/* field list, transition criteria format is the same as SQL's field list, query criteria format
"/*" field list is empty, all fields are blank, query condition is empty to get all data
''/***************************************************************************
Private S_conn
Private Objexcelapp,objexcelsheet,objexcelbook
Private Schar,endchar
''/***************************************************************************
'/* global variable
'/* External direct use: [OBJ]. sourcefile= source filename [OBJ]. targetfile= Target file name
''/***************************************************************************
Public Sourcefile,targetfile


Private Sub Class_Initialize
Schar= "ABCDEFGHIJKLNMOPQRSTUVWXYZ"
Objexcelapp=null
S_conn=null
End Sub
Private Sub Class_Terminate
If IsObject (S_conn) and not IsNull (S_conn) Then
S_conn.close
Set s_conn=nothing
End If
Closeexcel
End Sub

''/***************************************************************************
'/* Set/Return Conn Object
"/* Description: Add this is for other databases (such as: MSSQL) to the Access database data transfer and set
''/***************************************************************************
Public Property Set Conn (Snewvalue)
If not IsObject (snewvalue) Then
S_conn=null
Else
Set S_conn=snewvalue
End If
End Property
Public Property Get Conn
If IsObject (s_conn) Then
Set Conn=s_conn
Else
S_conn=null
End If
End Property

''/***************************************************************************
"* * Data transfer
'/* Function function: Transfer source data to targetfile database file
'/* Function Description: The use of SQL statements in the SELECT INTO in method transfer
'/* function return: Return some status code true = Transfer data Success False = Transfer data failure
'/* function parameter: stablename = table name of the source database
'/* scol = List of fields to transfer data in the same format as the field list for select
'/* sSQL = the condition at which data is transferred is the same as where the SQL statement follows the statement format
''/***************************************************************************
Public Function Transfer (stablename,scol,ssql)
On Error Resume Next
Dim Sql,rs
Dim Ifieldscount,imod,iimod,icount,i
If targetfile= "" Then "no target save file, transfer failed
Transfer=false
Exit Function
End If
If not initconn Then "error transferring data if Conn object cannot be initialized
Transfer=false
Exit Function
End If
If not initexcel Then "error transferring data if the Excel object cannot be initialized
Transfer=false
Exit Function
End If
If ssql<> "Then" condition query
Ssql= "Where" &ssql
End If
If scol= "Then" field list, separated by ","
Scol= "*"
End If
Set rs=server.createobject ("ADODB. RecordSet ")
Sql= "SELECT" &sCol& "from [" &sTableName& "]" &ssql
Rs.Open sql,s_conn,1,1
If err.number<>0 Then ' Error, transfer data error or transfer data success
Err.Clear
Transfer=false
Set rs=nothing
Closeexcel
Exit Function
End If
Ifieldscount=rs.fields.count
' No fields and no records exit
If ifieldscount<1 Or rs.eof Then
Transfer=false
Set rs=nothing
Closeexcel
Exit Function
End If
' Get the end letter of the cell
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& "" "" &rs.fields (IMod). Name
If imod=ifieldscount-1 Then
sexe=sexe& "" ")"
Else
sexe=sexe& "" ","
End If
Next
Execute sexe ' ' Write section name
If err.number<>0 Then ' Error, transfer data error or transfer data success
Err.Clear
Transfer=false
Rs.close
Set rs=nothing
Closeexcel
Exit Function
End If
i=2
Do Until rs.eof
Sexe= "Objexcelsheet.range" ("A" &i& ":" &EndChar&i& ""). Value = Array ("
For Imod=0 to IFieldsCount-1
sexe=sexe& "" "" &rs.fields (IMod). Value
If imod=ifieldscount-1 Then
sexe=sexe& "" ")"
Else
sexe=sexe& "" ","
End If
Next
Execute Sexe ' Write the first record
I=i+1
Rs.movenext
Loop
If err.number<>0 Then ' Error, transfer data error or transfer data success
Err.Clear
Transfer=false
Rs.close
Set rs=nothing
Closeexcel
Exit Function
End If
"Save the file
Objexcelbook.saveas TargetFile
If err.number<>0 Then ' Error, transfer data error or transfer data success
Err.Clear
Transfer=false
Rs.close
Set rs=nothing
Closeexcel
Exit Function
End If
Rs.close
Set rs=nothing
Closeexcel
Transfer=true
End Function

''/***************************************************************************
'/* Initialize the 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=true
End 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
End Sub

''/***************************************************************************
'/* Initialize the Adodb.connection Component Object
''/*
''/***************************************************************************
Private Function Initconn ()
On Error Resume Next
Dim 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
End If
Initconn=true
End Function
End Class
%>