设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
楼主: andymark
打印 上一主题 下一主题

[表] [分享]恢复误删Table的数据

[复制链接]
11#
发表于 2006-5-19 02:48:00 | 只看该作者
我也来凑过热闹:


Function UndoTable() As Integer


'===============================================================================


'-函数名称:         UndoTable


'-功能描述:         恢复删除的数据库对象


'-输入参数说明:


'-返回参数说明:     Integer 恢复数据库的个数


'-使用语法示例:     MsgBox UndoTable()


'-参考:             Access中国论坛帖子


'-使用注意:


'-兼容性:           2000,XP,2003


'-作者:             fan0217@163.com


'-更新日期:        2006-03-17


'===============================================================================


'On Error GoTo Err_UndoTable


Dim conn As New ADODB.Connection


Dim rs As New ADODB.Recordset


Dim strSQL As String


Dim strTemName As String


Dim i As Integer


   


Set conn = CurrentProject.Connection





    strSQL = "SELECT * FROM  MSysObjects "


    strSQL = strSQL & "WHERE(Left$([Name], 1) = '~')

And (Left$([Name], 4) <> 'Msys') And (MSysObjects.Type) = 1 "


   


    rs.Open strSQL, conn, 1, 3


        Do While Not rs.EOF


           strTemName = Right(rs("Name"), Len(rs("Name")) - 4)


           strSQL =

"SELECT * INTO [Undo_" & strTemName & "] FROM [" &

rs("Name") & "];"


           'conn.Execute strSQL


            DoCmd.SetWarnings False


            DoCmd.RunSQL strSQL


            DoCmd.SetWarnings True


            i = i + 1


           rs.MoveNext


        Loop


        


    UndoTable = i


   


    rs.Close


    Set rs = Nothing


    Set conn = Nothing





Exit_UndoTable:


    Exit Function





Err_UndoTable:


    Set rs = Nothing


    Set conn = Nothing


    MsgBox Err.Description


    Resume Exit_UndoTable





End Function








12#
发表于 2006-5-19 04:06:00 | 只看该作者
很实用的东西,支持。
13#
发表于 2006-5-19 16:48:00 | 只看该作者
精品,谢谢
14#
发表于 2006-5-19 18:53:00 | 只看该作者
11111
15#
发表于 2006-5-19 18:53:00 | 只看该作者
22222
16#
发表于 2006-5-19 18:54:00 | 只看该作者
33333下载个东西,要发三条垃圾信息。
17#
发表于 2006-5-20 05:13:00 | 只看该作者
我之前在某外文网站上摘录到的:

Undelete Tables and Queries
When you delete a table/query in Access, they don't actually get permanently deleted until Access is compacted using the Compact & Repair menu option.  

Instead, Access flags the objects as 'deleted' - fortunately for us these flags can be reversed.  When the items get flagged as 'deleted' Access also renames them to ~TMPCLP##### (#=Number) or similar, so unfortunately the names of the items are lost.  In Jet 4 files (Access 2000+) table names are usually recovered (by using the Unicode NameMap translation property of the table).  

The VBA code in this article shows how this can be achieved... (I've commented the code so you can follow it through if you want to see how its done).  


Option Compare Database
Option Explicit

' VBA MODULE: Undelete tables and queries in Microsoft Access
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 18/04/2005
'
' REQUIREMENTS: VBA DAO Reference, Access 97/2000/2002(XP)/2003
'
' This module will allow you to undelete tables and queries
' after they have been deleted in Access/Jet.
'
' Please note that this will only work if you haven't run the
' 'Compact' or 'Compact And Repair' option from Access/DAO.
' If you have run the compact option, your tables/queries
' have been permananetly deleted.
'
' You may modify this code as you please,
' However you must leave the copyright notices in place.
' Thank you.
'
' USAGE: Just import this VBA module into your project
' and call FnUndeleteObjects()
'
' If any un-deletable objects are found, you will be prompted
' to choose names for the undeleted objects.
' Note: In Access 2000, table names are usually recovered too.

Public Function FnUndeleteObjects() As Boolean

'Module (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
'Written 18/04/2005

On Error GoTo ErrorHandler:

    Dim strObjectName As String
    Dim rsTables As DAO.Recordset
    Dim dbsDatabase As DAO.Database

    Dim tDef As DAO.TableDef
    Dim qDef As DAO.QueryDef

    Dim intNumDeletedItemsFound As Integer

    Set dbsDatabase = CurrentDb

    For Each tDef In dbsDatabase.TableDefs
        'This is actually used as a 'Deleted Flag'
        If tDef.Attributes And dbHiddenObject Then

            strObjectName = FnGetDeletedTableNameByProp(tDef.Name)
            strObjectName = InputBox("A deleted TABLE has been found." & _
                                     vbCrLf & vbCrLf & _
                                     "To undelete this object, enter a new name:", _
                                     "Access Undelete Table", strObjectName)

            If Len(strObjectName) > 0 Then

                 FnUndeleteTable CurrentDb, tDef.Name, strObjectName

            End If

            intNumDeletedItemsFound = intNumDeletedItemsFound + 1

        End If

    Next tDef

    For Each qDef In dbsDatabase.QueryDefs

        'Note 'Attributes' flag is not exposed for QueryDef objects,
        'We could look up the flag by using MSysObjects but
        'new queries don't get written to MSysObjects until
        'Access is closed. Therefore we'll just check the
        'start of the name is '~TMPCLP' ...

        If InStr(1, qDef.Name, "~TMPCLP") = 1 Then

            strObjectName = ""
            strObjectName = InputBox("A deleted QUERY has been found." & _
                                     vbCrLf & vbCrLf & _
                                     "To undelete this object, enter a new name:", _
                                     "Access Undelete Query", strObjectName)

            If Len(strObjectName) > 0 Then

            
18#
发表于 2006-5-20 07:45:00 | 只看该作者
这个问题很早我也发过,没人注意,不过楼主的代码简洁了不少...谢谢分享!

相关连接:

http://www.office-cn.net/forum.php?mod=viewthread&tid=28585&replyID=&skin=1

http://www.accfans.net/dispbbs.asp?BoardID=22&ID=8370&replyID=52437&skin=1

寻欢也写了个工具,不过据说在2003下测试失败.

点击这里给我发消息

19#
发表于 2006-5-20 10:09:00 | 只看该作者
我看过,最早还是国外的文章.但不同的方法有不同的精妙,但对理解系统表及Access的原理都有帮助.
20#
发表于 2006-5-30 16:43:00 | 只看该作者
andymark版主发现新大陆
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-8 03:55 , Processed in 0.091112 second(s), 33 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表