Access Cookbook, 2nd Edition [Electronic resources] نسخه متنی

Recipe 6.8 Back Up Selected Objects to Another Database

6.8.1 Problem

You use a standard backup
program to save your databases, but this works only at the database
level. This is fine for archival purposes, but you often want to back
up individual objects. How can you get Access to display a list of
objects and allow you to save selected ones to an output database you
specify?

6.8.2 Solution

This
solution shows how to create a form that selectively saves Access
objects to another database. It works by using a multiselect list box
and the CopyObject action.

Open frmBackup from

06-08.MDB (Figure 6-11). You can use this form to back up selected
objects from the current database to another database. Select one or
more objects from the list box, using the Shift or Ctrl keys to
extend the selection. When you are finished selecting objects and
have specified a backup database (a default database name is created
for you), press the Backup button. The backup process will begin,
copying objects from the current database to the backup database.

Figure 6-11. frmBackup backing up selected database objects

To add this functionality to your own database, follow these steps:

1. Import frmBackup from

   06-08.MDB to your database.

2. Call the backup procedure
   from anywhere in your application by opening the frmBackup form. For
   example, you might place a command button on your main switchboard
   form with the following event procedure attached to the
   button's Click event:

   DoCmd.OpenForm "frmBackup"

6.8.3 Discussion

To see how it works, open frmBackup in design view. The form consists
of a list box, two text boxes (one of which is initially hidden), and
other controls. The list box control displays the list of objects.
One text box is used to gather the name of the backup database; the
other is used to display the progress of the backup operation. All of
the VBA code that makes frmBackup work is stored in the
form's module.

6.8.3.1 The MultiSelect property

The key control on the form is the
lboObjects list box. We have taken advantage of the list
box's MultiSelect property to allow the user to
select more than one item in the list box. This property can be set
to None, Simple, or Extended (see Figure 6-12). If
you set MultiSelect to None, which is the default setting, only one
item may be selected. If you choose Simple, you can select multiple
items, and an item will be selected whenever you click on it and will
remain selected until you click on it again. If you choose Extended,
the list box will behave like most of Windows's
built-in list box controlsyou select multiple items by holding
down the Shift or Ctrl keys while clicking on items.

Figure 6-12. The MultiSelect property set to Extended

6.8.3.2 Filling the lboObjects list box

Unlike most list boxes, which derive
their lists of values from either a fixed list of items or the rows
from a table or query, lboObjects uses a list-filling callback
function to fill the list box with the names of the database
container objects. List-filling functions are described in detail in
the Solution in Recipe 7.5. We use a
list-filling function here because the list of database container
objects is not stored in a user-accessible table. (Actually, you can
fill a list box with a list of database container objects using a
query based on the undocumented MSysObjects system table, but this
practice is not supported by Microsoft and therefore is not
recommended.) The list-filling function for lboObjects,

FillObjectList , is shown here:

Private Function FillObjectList(ctl As Control, varID As Variant, _
varRow As Variant, varCol As Variant, varCode As Variant) As Variant
' List filling function for lboObjects.
' Fills the list box with a list of
' the database container objects.
Dim varRetVal As Variant
Static sintRows As Integer
Dim itemInfo As Info
varRetVal = Null
Select Case varCode
Case acLBInitialize
' Fill mcolInfo with a list of
' database container objects
Set mcolInfo = New Collection
sintRows = FillObjCollection( )
varRetVal = True
Case acLBOpen
varRetVal = Timer
Case acLBGetRowCount
varRetVal = sintRows
Case acLBGetColumnCount
varRetVal = 4
Case acLBGetValue
' varRow and varCol are zero-based so add 1
Set itemInfo = mcolInfo(varRow + 1)
Select Case varCol
Case 0
varRetVal = itemInfo.ObjectType
Case 1
varRetVal = itemInfo.ObjectName
Case 2
varRetVal = itemInfo.DateCreated
Case 3
varRetVal = itemInfo.LastUpdated
End Select
Case acLBEnd
Set mcolInfo = New Collection
End Select
FillObjectList = varRetVal
End Function

FillObjectList looks like most typical
list-filling functions (see the Solution in Recipe 7.5 for more details). Most of the work is done
during the initialization step, when the

FillObjCollection
function is called to fill a module-level collection with
the list of database container objects:

Public Function FillObjCollection( ) As Integer
' Populates mcolInfo array with database container objects.
Dim db As DAO.Database
Dim con As DAO.Container
Dim doc As DAO.Document
Dim tdf As DAO.TableDef
Dim qdf As DAO.QueryDef
Dim strObjType As String
Dim intObjCount As Integer
Dim intItem As Integer
Dim fReturn As Boolean
On Error Resume Next
Set db = CurrentDb( )
' Setup the first row of field names
Call SaveToCollection("Type", "Name", "DateCreated", _
"LastUpdated")
' Special case TableDefs
db.TableDefs.Refresh
For Each tdf In db.TableDefs
' Only include non-system tables
If Not (tdf.Attributes And dbSystemObject) <> 0 Then
Call SaveToCollection("Table", tdf.Name, tdf.DateCreated, _
tdf.LastUpdated)
End If
Next tdf
' Special case QueryDefs
db.QueryDefs.Refresh
For Each qdf In db.QueryDefs
Call SaveToCollection("Query", qdf.Name, qdf.DateCreated, _
qdf.LastUpdated)
Next qdf
' Iterate through remaining containers of interest
' and then each document within the container
For Each con In db.Containers
Select Case con.Name
Case "Scripts"
strObjType = "Macro"
Case "Forms"
strObjType = "Form"
Case "Modules"
strObjType = "Module"
Case "Reports"
strObjType = "Report"
Case Else
strObjType = "
End Select
' If this isn't one of the important containers, don't
' bother listing documents.
If strObjType <> " Then
con.Documents.Refresh
For Each doc In con.Documents
' You can't backup the current form, since it's open.
If Not (doc.Name = Me.Name And con.Name = "Forms") Then
fReturn = SaveToCollection(strObjType, doc.Name, doc.DateCreated, _
doc.LastUpdated)
End If
Next doc
End If
Next con
FillObjCollection = mcolInfo.Count
End Function

The purpose of

FillObjCollection is to fill a Collection object
with a list of the names of each database container object, the type
of each object, the date and time each object was created, and the
date and time each object was last modified. Each item within this
collection is an instance of the Info class, defined in the sample
database. (Although the use of user-defined classes is beyond the
scope of this book, you can investigate the Info class and see that
it's quite simple. It behaves just like any other
object available as part of Access or VBAthe only difference
is that it's defined within your project.) In order
to gather the necessary information, the code must work through all
the available objects. This is accomplished by
"walking" the Containers collection
of the current database and working with the objects in each of the
containers. There are eight different containers in the Containers
collection, which are summarized in Table 6-7.

Because you are interested in backing up only the objects that appear
in the Access database container, the function should ignore any
containers in Table 6-7 for which
"Backup documents" is No.

FillObjArray places the list box headings in the
first item of the array:

' Set up the first row of field names
Call SaveToCollection("Type", "Name", "DateCreated", _
"LastUpdated")

We want the information in this first row to become the headings of
the list box, so we set the ColumnHeads property of the list box to
Yes. This setting tells Access to freeze the first row of the list
box so that it doesn't scroll with the other rows.
In addition, you cannot select this special row.

The function needs to walk the
collections storing away the information that will appear in the list
box. This

should be relatively simple, but there
is one complicating factor: the Tables container includes both tables
and queries, mixed together in unsorted order. Fortunately,
there's an alternate method for getting separate
lists of tables and queries in the database. Instead of using the
Tables container,

FillObjCollection walks the
TableDefs and QueryDefs collections to extract the necessary
information:

    ' Special case TableDefs
db.TableDefs.Refresh
For Each tdf In db.TableDefs
' Only include non-system tables
If Not (tdf.Attributes And dbSystemObject) <> 0 Then
Call SaveToCollection("Table", tdf.Name, tdf.DateCreated, _
tdf.LastUpdated)
End If
Next tdf
' Special case QueryDefs
db.QueryDefs.Refresh
For Each qdf In db.QueryDefs
Call SaveToCollection("Query", qdf.Name, qdf.DateCreated, _
qdf.LastUpdated)
Next qdf

The TableDefs collection requires an
additional test to exclude the normally hidden system tables from the
list.

With the tables and queries taken care of, the function can now walk
the remaining container collections for macros, forms, modules, and
reports:

    ' Iterate through remaining containers of interest
' and then each document within the container
For Each con In db.Containers
Select Case con.Name
Case "Scripts"
strObjType = "Macro"
Case "Forms"
strObjType = "Form"
Case "Modules"
strObjType = "Module"
Case "Reports"
strObjType = "Report"
Case Else
strObjType = "
End Select
' If this isn't one of the important containers, don't
' bother listing documents.
If strObjType <> " Then
con.Documents.Refresh
For Each doc In con.Documents
' You can't backup the current form, since it's open.
If Not (doc.Name = Me.Name And con.Name = "Forms") Then
fReturn = SaveToCollection(strObjType, 
doc.Name, _ doc.DateCreated, 
doc.LastUpdated)
End If
Next doc
End If
Next con

The

SaveToCollection subroutine called by

FillObjArray is shown here:

Private Function SaveToCollection(ByVal strType As String, ByVal strName As String, _
ByVal strDateCreated As String, ByVal strLastUpdated As String) As Boolean
' Skip deleted objects
Dim itemInfo As Info
Set itemInfo = New Info
If Left$(strName, 1) <> "~" Then
itemInfo.ObjectType = strType
itemInfo.ObjectName = strName
itemInfo.DateCreated = strDateCreated
itemInfo.LastUpdated = strLastUpdated
mcolInfo.Add itemInfo
SaveToCollection = True
Else
SaveToCollection = False
End If
End Function

Access doesn't
immediately remove database container objects that you have deleted.
Instead, it renames each deleted object to a name that begins with
"~TMPCLP". In addition, when you
use SQL statements for row sources or record sources, Access creates
hidden queries with names that also start with a tilde character
("~"). We don't
want these objects to appear in the list of objects to back up, so we
included code here to exclude them explicitly from the list box.

6.8.3.3 The backup process

Once you have selected one or more database objects in the lboObjects
list box, you initiate the backup process by clicking on the
cmdBackup command button. The event procedure attached to this button
calls the

MakeBackup subroutine. This routine
begins by checking to see if the backup database exists. If it does,
you are warned that it will be overwritten before proceeding. Next,

MakeBackup creates the output database using the
following code:

Set dbOutput = DBEngine.Workspaces(0). _
CreateDatabase(strOutputDatabase, dbLangGeneral)
dbOutput.Close

The output database is immediately closed, because the backup process
doesn't require it to be open.

MakeBackup then iterates through the selected
objects and calls

ExportObject , passing it the
name of the output database and the name and type of the object to be
backed up:

intObjCnt = 0
ctlProgress = "Backing up objects..."
For Each varItem In ctlObjects.ItemsSelected
intObjCnt = intObjCnt + 1
strType = ctlObjects.Column(0, varItem)
strName = ctlObjects.Column(1, varItem)
ctlProgress = "Backing up " & strName & "..."
DoEvents
Call ExportObject(strOutputDatabase, strType, strName)
Next varItem

The

ExportObject subroutine backs up each object
using the CopyObject action.

ExportObject is
shown here:

Private Sub ExportObject(strOutputDatabase As String, _
strType As String, strName As String)
Dim intType As Integer
Select Case strType
Case "Table"
intType = acTable
Case "Query"
intType = acQuery
Case "Form"
intType = acForm
Case "Report"
intType = acReport
Case "Macro"
intType = acMacro
Case "Module"
intType = acModule
End Select
' If export fails, let the user know.
On Error Resume Next
DoCmd.CopyObject strOutputDatabase, strName, intType, strName
If Err.Number <> 0 Then
Beep
MsgBox "Unable to backup " & strType & ": " & strName, _
vbOKOnly + vbCritical, "ExportObject"
End If
End Sub

6.8.3.4 Comments

This
technique uses the CopyObject action instead of the more traditional
TransferDatabase action. CopyObject, which was added in Access 2.0,
provides you with the same functionality as TransferDatabase, but
because it supports only Access objects it requires fewer arguments.
The CopyObject action also allows you to specify a new name for the
object in the destination database. This is useful if you want give
the copy a name that's different from that of the
source object.