Looking to take your VBA skills further?...

Discover twinBASIC — a powerful new development platform that expands on VBA and VB6 with advanced features, modern tools, and enhanced compatibility. Perfect for those ready to elevate their projects or transition from VBA, twinBASIC lets you build on what you already know and take your applications to the next level!

Try out twinBASIC Community Edition - it's free!

Undelete Tables and Queries in Access

        35 votes: *****     28,230 views      No comments
by Wayne Phillips, 18 April 2005    (for Access 97+)

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). 

PLEASE NOTE: The newer service packs for the Jet database engine prevent these techniques from working in most cases.  In order to recover deleted records, tables or queries you should instead consider using a data recovery service such as our Access Database Repair Service.

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 (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 (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

                 If FnUndeleteQuery(CurrentDb, qDef.Name, strObjectName) Then

                     'We'll rename the deleted object since we've made a
                     'copy and won't be needing to re-undelete it.

                     '(To break the condition "~TMPCLP" in future...)
                     qDef.Name = "~TMPCLQ" & Right$(qDef.Name, Len(qDef.Name) - 7)

                 End If

            End If

            intNumDeletedItemsFound = intNumDeletedItemsFound + 1

        End If

    Next qDef

    If intNumDeletedItemsFound = 0 Then

        MsgBox "Unable to find any deleted tables/queries to undelete!"

    End If

    Set dbsDatabase = Nothing
    FnUndeleteObjects = True

ExitFunction:
    Exit Function

ErrorHandler:
    MsgBox "Error occured in FnUndeleteObjects() - " & _
            Err.Description & " (" & CStr(Err.Number) & ")"
    GoTo ExitFunction

End Function

Private Function FnUndeleteTable(dbDatabase As DAO.Database, _
                                                strDeletedTableName As String, _
                                                strNewTableName As String)

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


    Dim tDef As DAO.TableDef

    Set tDef = dbDatabase.TableDefs(strDeletedTableName)

    'Remove the Deleted Flag...
    tDef.Attributes = tDef.Attributes And Not dbHiddenObject

    'Rename the deleted object to the original or new name...
        tDef.Name = strNewTableName

    dbDatabase.TableDefs.Refresh
    Application.RefreshDatabaseWindow

    Set tDef = Nothing

End Function

Private Function FnUndeleteQuery(dbDatabase As DAO.Database, _
                                                strDeletedQueryName As String, _
                                                strNewQueryName As String)

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

    'We can't just remove the Deleted flag on queries
    '('Attributes' is not an exposed property)
    'So instead we create a new query with the SQL...

    'Note: Can't use DoCmd.CopyObject as it copies the dbHiddenObject attribute!

        If FnCopyQuery(dbDatabase, strDeletedQueryName, strNewQueryName) Then

            FnUndeleteQuery = True
            Application.RefreshDatabaseWindow

        End If

End Function

Private Function FnCopyQuery(dbDatabase As DAO.Database, _
                                            strSourceName As String, _
                                            strDestinationName As String)

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


    On Error GoTo ErrorHandler:

    Dim qDefOld As DAO.QueryDef
    Dim qDefNew As DAO.QueryDef
    Dim Field As DAO.Field

    Set qDefOld = dbDatabase.QueryDefs(strSourceName)
    Set qDefNew = dbDatabase.CreateQueryDef(strDestinationName, qDefOld.SQL)

    'Copy root query properties...
        FnCopyLvProperties qDefNew, qDefOld.Properties, qDefNew.Properties

    For Each Field In qDefOld.Fields

        'Copy each fields individual properties...
            FnCopyLvProperties qDefNew.Fields(Field.Name), _
                                Field.Properties, _
                                qDefNew.Fields(Field.Name).Properties

    Next Field

    dbDatabase.QueryDefs.Refresh

    FnCopyQuery = True

ExitFunction:
    Set qDefNew = Nothing
    Set qDefOld = Nothing

    Exit Function

ErrorHandler:
    MsgBox "Error re-creating query '" & strDestinationName & "':" & vbCrLf & _
                Err.Description & " (" & CStr(Err.Number) & ")"
    GoTo ExitFunction

End Function

Private Function PropExists(Props As DAO.Properties, _
                             strPropName As String) As Boolean

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

'If properties fail to be created, we'll just ignore the errors

On Error Resume Next

    Dim Prop As DAO.Property

    For Each Prop In Props

        If Prop.Name = strPropName Then

            PropExists = True
            Exit Function ' Short circuit

        End If

    Next Prop

    PropExists = False

End Function

Private Sub FnCopyLvProperties(objObject As Object, _
                                                OldProps As DAO.Properties, _
                                                NewProps As DAO.Properties)

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

'If properties fail to be created, we'll just ignore the errors

On Error Resume Next

    Dim Prop As DAO.Property
    Dim NewProp As DAO.Property

    For Each Prop In OldProps

        If Not PropExists(NewProps, Prop.Name) Then

            If IsNumeric(Prop.Value) Then
                NewProps.Append objObject.CreateProperty(Prop.Name, _
                                                         Prop.Type, _
                                                         CLng(Prop.Value))
            Else
                NewProps.Append objObject.CreateProperty(Prop.Name, _
                                                         Prop.Type, _
                                                         Prop.Value)
            End If

        Else

            With NewProps(Prop.Name)

                .Type = Prop.Type
                .Value = Prop.Value

            End With

        End If

    Next Prop

End Sub

Private Function FnGetDeletedTableNameByProp(strRealTableName As String) _
                                             As String

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

'If an error occurs here, just ignore (user will override the blank name)

On Error Resume Next

    Dim i As Long
    Dim strNameMap As String

    'Try to extract the name from the AutoCorrect data if it's available...

    strNameMap = CurrentDb.TableDefs(strRealTableName).Properties("NameMap")
    strNameMap = Mid(strNameMap, 23) 'Offset of the table name...

    'Find the null terminator...
    i = 1
    If Len(strNameMap) > 0 Then

        While (i < Len(strNameMap)) and (Asc(Mid(strNameMap, i)) <> 0)

            i = i + 1

        Wend

    End If

    FnGetDeletedTableNameByProp = Left(strNameMap, i - 1)

End Function

*Microsoft Access is a trademark of Microsoft Corporation in the United States and other countries*

IMPORTANT: This document may not be reproduced in part or whole without prior consent from the author.

www.everythingaccess.com

Rate this article:  Your rating: PoorYour rating: Not so goodYour rating: AverageYour rating: GoodYour rating: Excellent


Have your say - comment on this article.

What did you think of 'Undelete Tables and Queries in Access'?

No comments yet.

Why not be the first to comment on this article?!

Have your say...

Name
E-mail (e-mail address will be kept private)
Comments


Comments require approval before being displayed on this page (allow 24 hours).