(原创)备份数据库类 Excel篇(V2.0版)

原创 2004年08月19日 09:54:00

此版本比1.0版本功能增强了许多,并且也和ACCESS那类一样,可以多表存为一个文件,并也可每一表存一文件,使用方法都是相同的了。在此版本中还增加了一个方法:[Obj].Close,此方法是为了不想注销类,但又想结束类使用的Excel进程时所增加的。

<%
Class DataBaseToExcel
'/***************************************************************************
'/*               转移数据到Excel文件(备份数据库类  Excel篇)  V2.0
'/*作者:死在水中的鱼(死鱼)
'/*日期:2004年8月4日
'/*Blog:http://blog.csdn.com/bpfish
'/*
'/*声明:使用此类必需服务器上装有Office(Excel)程序,否则使用时可能不能转移数据
'/*      此版本的类支持一Excel文件存放多数据表,也可将每一个数据表存放为一个文件,
'/*      使用方法是在Transfer表之前更换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的“字段列表”,“查询条件”格式相同
'/*            "字段列表"为空则是所有字段,“查询条件”为空则获取所有数据
'/*      此版本增加了一个方法Close,此方法是为了不想注销类但又想把数据保存到文件并结束Excel进程时使用
'/***************************************************************************
Private s_Conn
Private objExcelApp,objExcelSheet,objExcelBook
Private sChar,EndChar,iSheet
'/***************************************************************************
'/*             全局变量
'/*外部直接使用:[Obj].SourceFile=源文件名
'/***************************************************************************
Public SourceFile
Private s_TargetFile


Private Sub Class_Initialize
        sChar="ABCDEFGHIJKLNMOPQRSTUVWXYZ"
  objExcelApp=Null
        s_Conn=Null
  iSheet=1         '标记当前的活动的Excel工作表(初始范围是1--3)
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)到Excel数据库的数据转移而设置的
'/***************************************************************************
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

'/***************************************************************************
'/*             设置/返回Target对象
'/*说明:当改变TargetFile时对以前有做移动数据的则保存
'/***************************************************************************
Public Property Let TargetFile(sNewValue)
       If UCase(sNewValue)<>UCase(s_TargetFile) Then     '改变文件,则关闭以前的Excel进程
       CloseExcel
    End If
       s_TargetFile=sNewValue
End Property
Public Property Set TargetFile(sNewValue)
       If UCase(sNewValue)<>UCase(s_TargetFile) Then     '改变文件,则关闭以前的Excel进程
       CloseExcel
    End If
       s_TargetFile=sNewValue
End Property
Public Property Get TargetFile
    TargetFile=s_TargetFile
End Property

'/***************************************************************************
'/*             数据转移
'/*函数功能:转移源数据到TargetFile数据库文件
'/*函数说明:利用SQL语句的Select Into In方法转移
'/*函数返回:返回一些状态代码True = 转移数据成功   False = 转移数据失败
'/*函数参数:sTableName = 源数据库的表名
'/*         sCol = 要转移数据的字段列表,格式则同Select 的字段列表格式相同
'/*         sSql = 转移数据时的条件 同SQL语句的Where 后面语句格式一样
'/***************************************************************************
Public Function Transfer(sTableName,tTableName,sCol,sSql)
On Error Resume Next
Dim SQL,Rs
Dim iFieldsCount,iMod,iiMod,iCount,i
    If s_TargetFile="" Then       '没有目标保存文件,转移失败
       Transfer=False
    Exit Function
    End If
    If sTableName="" Then         '没有数据表,转移失败
       Transfer=False
    Exit Function
    End If
    If tTableName="" Then         '没有目标表名使用源表名
       tTableName=sTableName
    End If
       If Not InitConn Then          '如果不能初始化Conn对象则转移数据出错
       Transfer=False
    Exit Function
    End If
       If Not CreateSheet(tTableName) Then       '如果不能初始化Excel对象并不能激活Sheet工作表则转移数据出错
       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
    Exit Function
    End If
       iFieldsCount=Rs.Fields.Count
   '没字段和没有记录则退出
   If iFieldsCount<1 Or Rs.Eof Then
          Transfer=False
    Set Rs=Nothing
    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
   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
   Exit Function
   End If
   '保存文件
   If iSheet=1 Then              '第一张工作表时保存为文件
      objExcelBook.SaveAs  s_TargetFile
   Else
      objExcelBook.Save          '其它工作表直接Save
   End If
   If Err.Number<>0 Then         '出错则转移数据错误,否则转移数据成功
      Err.Clear
         Transfer=False
   Rs.Close
   Set Rs=Nothing
   Exit Function
   End If
   Rs.Close
   Set Rs=Nothing
   iSheet=iSheet+1               '新Excel工作表
      Transfer=True
End Function

'/***************************************************************************
'/*             关闭Excel进程,并保存数据
'/*
'/***************************************************************************
Public Sub Close
       CloseExcel
End Sub

'/***************************************************************************
'/*             初始化Excel组件对象
'/*
'/***************************************************************************
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=True
End Function
Private Function CreateSheet(sName)           '建立Excel的Sheet并激活
        If Not InitExcel Then
     CreateSheet=False
     Exit Function
  End If
  On Error Resume Next
  If iSheet<=3 Then      '如果iSheet的值还在1,2,3则不用新建工作表,Excel默认有三张表
     Set objExcelSheet = objExcelBook.Sheets(iSheet)
  Else
     Set objExcelSheet = objExcelBook.Sheets.add
  End If
  objExcelSheet.Name=sName
  If Err.Number<>0 Then
     CreateSheet=False
     Exit Function
  End If
  CreateSheet=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
     iSheet=1
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
%>

如何将高版本的SQL Server数据库备份到低版本的SQL Server

如何将SQL Server2014的数据库备份到SQL Server2012
  • wang465745776
  • wang465745776
  • 2017年02月10日 13:52
  • 2811

SQL Server2014数据库的备份和还原

在系统开发的过程中,把DB备份,并还原到其他的服务器上,或者在本机上在还原出一个数据库的操作很常见。 大概步骤是: 1.以sa账号登录,在需要备份的DB上选择右键->任务->备份 2. ...
  • zpf0901
  • zpf0901
  • 2017年04月25日 17:09
  • 2317

Navicat for PostgreSQL 怎么维护数据库和表

Navicat for PostgreSQL一套适用于PostgreSQL数据库系统地图形化数据库管理、报告以及监控的工具。新版本具有高性能的、具有商业智能的、强大的备份功能,此外还有许多的改进。简体...
  • mathsoftware
  • mathsoftware
  • 2016年04月11日 14:33
  • 1156

原创 随手搜索 V2.0版 软件

  • 2014年02月12日 17:11
  • 3.64MB
  • 下载

djangoBook 中文 v1.0 v2.0 合并美化版 原创

  • 2011年05月27日 13:04
  • 2.37MB
  • 下载

北国药苑数据库备份文件 v2.0

  • 2005年12月09日 10:16
  • 13KB
  • 下载

数据库自动备份工具 v2.0(含源码)

  • 2009年09月10日 13:15
  • 408KB
  • 下载

[原创]修正SubSonic v2.2.1的一处BUG,以及如何使用SubSonic进行多表查询、子查询以及数据库分页

相信很多同学都用过SubSonic,在07 - 10年ORM兴起的时代,SubSonic可以说是DotNet开发人员的救星。虽说现在 EntityFramework大有一统江湖的趋势,不过在DotNe...
  • u010918003
  • u010918003
  • 2013年06月24日 11:34
  • 679

路过秋天版博客 V2.0 测试版发布 公测一周[支持多语言、多用户、多数据库、目录级URL]

路过秋天版博客发布历史回顾: 1:2010年11月08日---支持多语言、多用户、多数据库、目录级URL之路过秋天版博客发布[绝对有杀伤力的博客] 2:2010年11月10日---基础却容易被忽略...
  • cyq1162
  • cyq1162
  • 2016年11月23日 12:09
  • 157

路过秋天版博客 V2.0 正式版发布 增加后台管理系统[支持多语言、多用户、多数据库、目录级URL]

路过秋天版博客发布历史回顾: 1:2010年11月08日---支持多语言、多用户、多数据库、目录级URL之路过秋天版博客发布[绝对有杀伤力的博客] 2:2010年11月10日---基础却容易被忽略...
  • cyq1162
  • cyq1162
  • 2016年11月23日 12:10
  • 258
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:(原创)备份数据库类 Excel篇(V2.0版)
举报原因:
原因补充:

(最多只允许输入30个字)