Sub Link()
‘This process checks for the presence of a slave backend and links to it accordingly.
‘If a slave is not found it then links the frontend to the master backend Db
Dim strTarget As String
Dim tdf As TableDef, db As Database
'Point an object at the current db.
Set db = CurrentDb
'Refresh the object to reflect the current db schema
'N.B. I have commented this out as users cannot change the db schema anyway.
'Use of the refresh could slow the relink process when the frontend communicates
'with the backend database on the remote G drive.
'db.TableDefs.Refresh
'Now look for a slave copy of the database on the local drive.
'If it is not there the client must be on a machine in Crewe linked to the
'Master database and therefore no reconnect is required.
'Note the use of the "?" wildcard to make sure we pick up all variations of
'slave db names for the 03 trading year. I use a different name for each slave
‘db on each PC but my frontend only needs to know the filename pattern
‘not the full name. That way I can still use the same front end code for
‘every local and remote PC.
strTarget = Dir("C:\OTS_Db\Rep\OTS_Rep?03.mdb")
'Now only connect to the slave if we have found one.
If strTarget <> "" Then
'Loop through all the tables in the current db.
For Each tdf In db.TableDefs
'Check each table for a connect string
With tdf
If Len(.Connect) > 0 Then
'Once found update it to point to the slave db previously found.
.Connect = ";Database=C:\OTS_Db\Rep\" & strTarget
'Refresh the link to make it stick.
.RefreshLink
End If
End With
Next
Else
'Otherwise connect to the Master database on the G: drive
'Loop through all the tables in the current db.
For Each tdf In db.TableDefs
'Check each table for a connect string
With tdf
If Len(.Connect) > 0 Then
'Once found update it to point to the master db
.Connect = ";Database=G:\ots_be\ots_be03.mdb"
'Refresh the link to make it stick.
.RefreshLink
End If
End With
Next
End If
'Tidy up defined objects now we are done.
Set tdf = Nothing
Set db = Nothing
End Sub
Private Sub Form_Load()
Dim strFile As String, strSpec As String, sngStart As Single, sngEnd As Single, sngElap As Single
Dim intMins As Integer, intSecs As Integer
'Get the slave database name.
strFile = Dir("C:\OTS_Db\Rep\OTS_Rep?03.mdb")
'Set up the complete filepath for the location of the slave database.
strSpec = "C:\OTS_Db\Rep\" & strFile
'Look for a database backup from any previous compact and if found kill it.
If Dir("C:\OTS_Db\Rep\RepBak03.mdb") <> "" Then
Kill ("C:\OTS_Db\Rep\RepBak03.mdb")
End If
'Before carrying out a sync, complete a database repair and a compact.
'First do the repair operation
'N.B. Commented out as no longer required or valid for Access 2000 dbs
'DBEngine.RepairDatabase strSpec
'Then Compact the Replicated database to the RepBak backup file
DBEngine.CompactDatabase strSpec, "C:\OTS_Db\Rep\RepBak03.mdb"
'Then Kill the original slave database file as described in strSpec
Kill (strSpec)
'Then compact the RepBak file back to the original slave database file
DBEngine.CompactDatabase "C:\OTS_Db\Rep\RepBak03.mdb", strSpec
'Now start the sync process.
'Let the user know what is going on.
lblStatus.Caption = "Please wait - synchronisation with Master Database in progress."
'Set the timer start variable before begining synchronisation.
sngStart = Timer
'Call the routine which does the sync., passing the filespec for the target replicated db, ‘the filespec for the master db and an integer representing the type of sync to be ‘carried out
Call SynchronizeDBs(strSpec, "G:\OTS_BE\ots_be03.mdb", 1)
'Now that the sync is finished get the end time.
sngEnd = Timer
'Work out the total elapsed time.
sngElap = sngEnd - sngStart
'Work out the number of minutes elapsed. (not too many hopefully)
intMins = Int(sngElap / 60)
'Work out the number of remaining seconds too.
intSecs = sngElap Mod 60
'Set up the results caption with the appropriate message.
lblStatus.Caption = "Synchronisation completed in " & intMins
If intMins = 1 Then
lblStatus.Caption = lblStatus.Caption & " minute and " & intSecs
Else
lblStatus.Caption = lblStatus.Caption & " minutes and " & intSecs
End If
If intSecs = 1 Then
lblStatus.Caption = lblStatus.Caption & " second."
Else
lblStatus.Caption = lblStatus.Caption & " seconds."
End If
'Enable the form close button now the sync is complete.
cmdOK.Enabled = True
End Sub
Sub SynchronizeDBs(strDBName As String, strSyncTargetDB As String, intSync As Integer)
'This process carries out the required database synchronisation between the local slave
'and the database Master.
Dim dbs As Database
Set dbs = DBEngine(0).OpenDatabase(strDBName)
Select Case intSync
Case 1 'Synchronize replicas (bidirectional exchange).
dbs.Synchronize strSyncTargetDB, dbRepImpExpChanges
Case 2 'Synchronize replicas (Export changes).
dbs.Synchronize strSyncTargetDB, dbRepExportChanges
Case 3 'Synchronize replicas (Import changes).
dbs.Synchronize strSyncTargetDB, dbRepImportChanges
Case 4 'Synchronize replicas (Internet).
dbs.Synchronize strSyncTargetDB, dbRepSyncInternet
End Select
dbs.Close
Set dbs = Nothing
End Sub