数据库备份转换为Excel文件类 - ASP教程

使用方法请仔细阅读下面的注解说明!!

<%
Class DataBaseToExcel
''/***************************************************************************
''/*　　转移数据到Excel文件(备份数据库类　 Excel篇）　 V1.0
''/*作者：死在水中的鱼(死鱼）
''/*日期：2004年8月4日
''/*Blog:http://blog.lznews.cn/blog.asp?name=哇哇鱼
''/*
''/*声明：使用此类必需服务器上装有Office（Excel）程序，否则使用时可能不能转移数据
''/*　　此版本的类暂时只支持一次转换一个数据表，即一个数据表只能对应一个Excel文件。
''/*　　如果转换一个数据表后不更换TargetFile参数，则将覆盖以前的表数据！！！！
''/*用法：
''/*方法一：（Access数据库文件 TO Excel数据库文件）
''/*1、先设置源数据库文件SourceFile（可选）和目标数据库文件TargetFile（必选）
''/*2、再使用Transfer("源表名","字段列表","转移条件")方法转移数据
''/*例子：
''/*　　 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 "转移数据成功！"
''/*　　 Else
''/*　　　　　 Response.Write "转移数据失败！"
''/*　　 End If
''/*　　 Set ObjClass=Nothing
''/*
''/*方法二：（其它数据库文件 To Excel数据库文件)
''/*1、设置目标数据库文件TargetFile
''/*2、设置Adodb.Connection对象
''/*3、再使用Transfer("源表名","字段列表","转移条件")方法转移数据
''/*例子：(在此使用Access的数据源做例子，你可以使用其它数据源）
''/*　　 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　　　　　　　 ''此处关键
''/*　　 ObjClass.TargetFile=tFile
''/*　　 sResult=ObjClass.Transfer("table1","","")
''/*　　 If sResult Then
''/*　　　　　 Response.Write "转移数据成功！"
''/*　　 Else
''/*　　　　　 Response.Write "转移数据失败！"
''/*　　 End If
''/*　　 Set ObjClass=Nothing
''/*　　 Conn.Close
''/*　　 Set Conn=Nothing
''/*　
''/*说明：TargetFile属性一定要设置！（备份文件地址，绝对地址！）
''/*　如果不设置SourceFile则一定要设置Conn，这两个属性必选之一，但优先权是Conn
''/*　方法：Transfer("源数据表名","字段列表","转移条件")
''/*　　　“字段列表；转移条件”格式与SQL的“字段列表”,“查询条件”格式相同
''/*　　　　"字段列表"为空则是所有字段，“查询条件”为空则获取所有数据
''/***************************************************************************
Private s_Conn
Private objExcelApp,objExcelSheet,objExcelBook
Private sChar,EndChar
''/***************************************************************************
''/*　　　　　　　　　　　　 全局变量
''/*外部直接使用：[Obj].SourceFile=源文件名　　 [Obj].TargetFile=目标文件名
''/***************************************************************************
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

''/***************************************************************************
''/*　　　　　　　　　　　　 设置/返回Conn对象
''/*说明：添加这个是为了其它数据库(如：MSSQL）到ACCESS数据库的数据转移而设置的
''/***************************************************************************
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

''/***************************************************************************
''/*　　　　　　　　　　　　 数据转移
''/*函数功能：转移源数据到TargetFile数据库文件
''/*函数说明：利用SQL语句的Select Into In方法转移
''/*函数返回：返回一些状态代码True = 转移数据成功　　 False = 转移数据失败
''/*函数参数：sTableName = 源数据库的表名
''/*　　　　　　　　 sCol = 要转移数据的字段列表，格式则同Select 的字段列表格式相同
''/*　　　　　　　　 sSql = 转移数据时的条件 同SQL语句的Where 后面语句格式一样
''/***************************************************************************
Public Function Transfer(sTableName,sCol,sSql)
On Error Resume Next
Dim SQL,Rs
Dim iFieldsCount,iMod,iiMod,iCount,i
　　　　　　 If TargetFile="" Then　　''没有目标保存文件，转移失败
　　　　　　　　　 Transfer=False
　　　　　　　　　　　 Exit Function
　　　　　　 End If
　　　　　 If Not InitConn Then　　　　''如果不能初始化Conn对象则转移数据出错
　　　　　　　　　 Transfer=False
　　　　　　　　　　　 Exit Function
　　　　　　 End If
　　　　　 If Not InitExcel Then　　　　''如果不能初始化Excel对象则转移数据出错
　　　　　　　　　 Transfer=False
　　　　　　　　　　　 Exit Function
　　　　　　 End If
　　　　　 If sSql<>"" Then　　　　　　　''条件查询
　　　　　　　　　 sSql=" Where "&sSql
　　　　　　 End If
　　　　　　 If sCol="" Then　　　　　　　''字段列表,以","分隔
　　　　　　　　　 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　　　　''出错则转移数据错误，否则转移数据成功
　　　　　　　　　 Err.Clear
　　　　　　　　 Transfer=False
　　　　　　　　　　　 Set Rs=Nothing
　　　　　　　　　　　 CloseExcel
　　　　　　　　　　　 Exit Function
　　　　　　 End If
　　　　　 iFieldsCount=Rs.Fields.Count
　　　　　 ''没字段和没有记录则退出
　　　　　 If iFieldsCount<1 Or Rs.Eof Then
　　　　　　　　 Transfer=False
　　　　　　　　　　　 Set Rs=Nothing
　　　　　　　　　　　 CloseExcel
　　　　　　　　　　　 Exit Function
　　　　　 End If
　　　　　 ''获取单元格的结尾字母
　　　　　 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　　　 ''运行字符串

　　　　　 ''字段名列表
　　　　　 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　　　　　 ''写字段名
　　　　　 If Err.Number<>0 Then　　''出错则转移数据错误，否则转移数据成功
　　　　　　　　 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　　　''写第i个记录
　　　　　　　　　　 i=i+1
　　　　　　　　　　 Rs.MoveNext
　　　　　 Loop
　　　　　 If Err.Number<>0 Then　　　''出错则转移数据错误，否则转移数据成功
　　　　　　　　 Err.Clear
　　　　　　　 Transfer=False
　　　　　　　　　　 Rs.Close
　　　　　　　　　　 Set Rs=Nothing
　　　　　　　　　　 CloseExcel
　　　　　　　　　　 Exit Function
　　　　　 End If
　　　　　 ''保存文件
　　　　　 objExcelBook.SaveAs　 TargetFile
　　　　　 If Err.Number<>0 Then　　　''出错则转移数据错误，否则转移数据成功
　　　　　　　　 Err.Clear
　　　　　　　 Transfer=False
　　　　　　　　　　 Rs.Close
　　　　　　　　　　 Set Rs=Nothing
　　　　　　　　　　 CloseExcel
　　　　　　　　　　 Exit Function
　　　　　 End If
　　　　　 Rs.Close
　　　　　 Set Rs=Nothing
　　　　　 CloseExcel
　　　　 Transfer=True
End Function

''/***************************************************************************
''/*　　　　　　　　　　　　 初始化Excel组件对象
''/*
''/***************************************************************************
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

''/***************************************************************************
''/*　　　　　　　　　　　　 初始化Adodb.Connection组件对象
''/*
''/***************************************************************************
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
%>

（编辑：滁州站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!