DBBackup

'Windows API/Global Declarations for :ACCESS BACKUP ROUTINE

Const modulename = "MBackup"

Function BackupDataBase (filename$) As Integer
On Error GoTo BackupDataBase_Err
Dim newDB As Database, oldDB As Database, oldTable As TableDef
Dim tempname As String, path As String, intIndex As Integer, numTables As Integer
Dim intIndex2 As Integer, errorFlag As Integer
' 'backup defaults to current directory,...

path = GetApplicationDir() & filename$
'replace above line with this one to pass a full path to thi

' s function

' 'path = filename$

' 'If database already exists, delete it.


If MB_FileExists(path) Then
Kill path
End If

' 'create new file

Set newDB = DBEngine.workspaces(0).CreateDatabase(path, DB_LANG_GENERAL)
newDB.Close
Set oldDB = DBEngine(0)(0)
' 'Get number of tables and their names

numTables = oldDB.tabledefs.count - 1
' 'Actually export all the tables in the list.


For intIndex = 0 To numTables
tempname = oldDB.tabledefs(intIndex).name

If ValidTableFilter(tempname) Then

DoCmd TransferDatabase A_EXPORT, "Microsoft Access", path, A_TABLE, tempname, tempname
End If

Next intIndex

BackupDataBase = True
BackupDataBase_Exit:

If errorFlag Then
BackupDataBase = False
'if we errored out, then destroy the backup, (less risk of u

' sing incorrect file).


If MB_FileExists(path) Then
Kill path
End If

Else
BackupDataBase = True
End If

Exit Function
BackupDataBase_Err:
MsgBox "Backup Failed! Error: " & Error$, 16, "FUNCTION: BackupDataBase( " & filename$ & " )"
errorFlag = True
Resume BackupDataBase_Exit
End Function

Function GetApplicationDir () As String

'***********************************************************

' '* PROCEDURE: GetApplicationDir

' '* ARGS: NONE

' '* RETURNS:App's dir

' '* CREATED:8/2/95 GDK

' '* REVISED:

'* CommentsRetrieves App's directory, (actually the current

' MDB's dir.)

'***********************************************************

Dim d As Database, path As String, i%
Set d = DBEngine(0)(0)
path = d.name
d.Close

For i% = Len(path) To 0 Step -1

If Mid$(path, i%, 1) = "\" Then
path = Left$(path, i%)
Exit For
End If

Next i%

GetApplicationDir = path
End Function

'***********************************************************

' '* FUNCTION: MB_FileExists

' '* ARGUMENTS: strFilename-- name of file to look for

' '* RETURNS:TRUE/FALSE -- TRUE = File Exists

' '* CREATED:8/95 GDK Initial Code

' '* CHANGED:N/A

'***********************************************************


Function MB_FileExists (strFileName As String) As Integer

' '

' 'Check to see if file strFileName exists

' '


If Len(Dir$(strFileName)) Then
MB_FileExists = True
End If

End Function

'***********************************************************

' '* FUNCTION: ValidTableFilter

' '* ARGUMENTS: tablename$ -- table to OK for export

' '* RETURNS:TRUE/FALSE -- TRUE = OK to export

' '* PURPOSE:Screen out invalid tables by testing them here.

' '* CREATED:2/97 GDK Initial code

' '* CHANGES:N/A

'***********************************************************


Function ValidTableFilter (tablename$) As Integer

On Error GoTo ValidTableFilter_Error:

If Left$(tablename$, 4) = "MSys" Then
Exit Function
End If


If tablename$ = "" Then
Exit Function
End If

' 'Add test functions above this line.

ValidTableFilter = True
ValidTableFilter_Exit:
Exit Function
ValidTableFilter_Error:
MsgBox Error, 16, "FUNCTION: ValidTableFilter( " & tablename$ & ")"
Resume ValidTableFilter_Exit
End Function