Basculer automatiquement d'une base de données vers une base de données de backup                   

wpe2.gif (1107 octets)exemple

 

 

L'exemple ci-dessous permet au démarrage de basculer automatiquement d'une base de données de production (par exemple C:\COURS\TESTDATA1.MDB) vers la base de données de backup (par exemple C:\COURS\TESTDATA2.MDB) lorsque la base de données de production n'est plus disponible.
réciproquement, au démarrage, il y a retour automatique à la base de données de production si cette dernière est de nouveau disponible.

Cette exemple pourrait être adapté pour accèder à une base de données ODBC (SQL Server,...) simplement en adaptant la chaîne de connection.

TestCode.mdb , qui contient l'application
TestData1.mdb qui contient les données de production
TestData2.mdb qui contient les données de backup

 

Public Function gFctAttacheTable()

' But :
' On essaie de se connecter à la base de données TestData1.mdb; si ce
' n'est pas possible, on bascule sur TestData2.mdb
' Le nom de la dernière base de données utilisée est sauvé dans la table Parametres
' de la base de données TestCode.mdb

' Utilisation :
' Cette fonction est lancée ,par exemple, par la macro AutoExec de TestCode
' Action : RunCode
' Nom de la fonction : gFctAttacheTable()

' Principe
' On essaie d'attacher une table de TestData1.mdb (ex:Clients).Si une erreur
' se produit, on utilise le chemin d'accès "C:\cours\TestData2.mdb"
' pour attacher les tables autres que celles commençant par "MSYS"

Dim db As Database
Dim db1 As Database
Dim rec1 As Recordset
Dim rec2 As Recordset
Dim DernierChemin As String
Dim i As Integer
Dim chemin As String

On Error GoTo err_gFctAttacheTable

Set db = DBEngine(0)(0)

' vérifie le dernier accès dans la table Parametres
' si le dernier chemin est "C:\cours\TestData2.mdb", il essaie
' de se reconnecter sur "C:\cours\TestData1.mdb"

Set rec1 = db.OpenRecordset("Parametres")
DernierChemin = rec1("DernierChemin")
If DernierChemin = "C:\cours\TestData2.mdb" Then
chemin = "C:\cours\TestData1.mdb"
For i = 0 To db.TableDefs.Count - 1
If UCase(db.TableDefs(i).Name) <> "Parametres" And _
UCase(Left(db.TableDefs(i).Name, 4)) <> "MSYS" Then
db.TableDefs(i).Connect = ";DATABASE=" & chemin
db.TableDefs(i).RefreshLink
End If
Next i

' mise à jour de la dernière connection dans la table Parametres
rec1.Edit
rec1("DernierChemin") = "C:\cours\TestData1.mdb"
rec1.Update
MsgBox ("Vous êtes attachés à C:\cours\TestData1.mdb")
gFctAttacheTable = True
Exit Function
End If

' teste d'ouverture d'une table - si erreur, va en err_gFctAttacheTable:
Set rec2 = db.OpenRecordset("Clients")

fin_gFctAttacheTable:
Exit Function

err_gFctAttacheTable:
'
chemin = "C:\cours\TestData2.mdb"
For i = 0 To db.TableDefs.Count - 1
If UCase(db.TableDefs(i).Name) <> "Parametres" And _
UCase(Left(db.TableDefs(i).Name, 4)) <> "MSYS" Then
db.TableDefs(i).Connect = ";DATABASE=" & chemin
db.TableDefs(i).RefreshLink
End If

Next i

rec1.Edit
rec1("DernierChemin") = "C:\cours\TestData2.mdb"
rec1.Update
MsgBox ("Vous êtes attachés à C:\cours\TestData2.mdb")
gFctAttacheTable = True
Exit Function

End Function

Action : RunCode
Nom de la fonction : gFctAttacheTable()