1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
Public Sub RattacherTablesBaseDorsale(ByVal FichierBaseDeDonnee As String, ByVal NomBaseDeDonnee As String)
Const ERROR_TABLEFR As String = "Table des erreurs"
Const ERROR_TABLEUS As String = "Paste Errors"
Dim oDB As DAO.Database
Dim oTDF As DAO.TableDef
Dim N As Integer
Dim strTableCible As String
Dim strTableSource As String
Dim strLienTemp As String
Dim strBaseDeDonneeLiee As String
Dim T As Integer
On Error GoTo L_ErrRattacherTablesBaseDorsale
DoCmd.SetWarnings False
DoCmd.Hourglass True
On Error GoTo L_ErrRattacherTablesBaseDorsale
'Set oDB = DBEngine.OpenDatabase(FichierBaseDeDonnee)
Set oDB = CurrentDb
strBaseDeDonneeLiee = FichierBaseDeDonnee
'Pour chaque table de la base donnée frontales (celles qui sont liées)
For Each oTDF In oDB.TableDefs
'Avec l'objet de définition de table
With oTDF
'Si c'est une table attachée et que ce n'est pas une table système
If .Attributes = dbAttachedTable And Not .Attributes = dbSystemObject Then
'On prend le chemin de la liaison en place
strLienTemp = oTDF.Connect
'Si dans ce lien c'est la base de données attendue (il peut y avoir plusieurs bases attachées) et que le chemin est incorrect
If InStr(1, strLienTemp, NomBaseDeDonnee, vbTextCompare) And InStr(1, strLienTemp, FichierBaseDeDonnee, vbTextCompare) = 0 Then
'On prend le nom de la première table
strTableSource = oTDF.Name
'On vérifie que ce n'est pas une table des erreurs
Select Case strTableSource
Case ERROR_TABLEFR, ERROR_TABLEUS
Case Else
'On remplace ou donne le nom souhaité de la table cible (pas forcément le même que la table source mais c'est rare)
strTableCible = strTableSource
'On efface la table liée d'abord dans la base frontale
DoCmd.DeleteObject acTable, strTableSource
'On rattache la table
DoCmd.TransferDatabase acLink, "Microsoft Access", strBaseDeDonneeLiee, acTable, strTableSource, strTableCible
T = T + 1
End Select
End If
End If
End With
'On passe à la table suivante
Next oTDF
'On ferme l'instance le la base de données
If Not oDB Is Nothing Then oDB.Close
If T Then
MsgBox T & " tables on été rattachées avec succès.", vbInformation, "Fin d'opération"
Else
MsgBox "Aucune table n'a été rattachée, toutes l'étaient déjà correctement.", vbInformation, "Fin"
End If
On Error GoTo 0
L_ExRattacherTablesBaseDorsale:
'On libère les objets
Set oTDF = Nothing
Set oDB = Nothing
DoCmd.Hourglass False
Exit Sub
L_ErrRattacherTablesBaseDorsale:
MsgBox Err.Description, vbExclamation, Err.Source
Resume L_ExRattacherTablesBaseDorsale
End Sub |
Définition des chemins dans le Runtime
Répondre avec citation
), j'ai été confronté à ce type de problème (dire que je me suis amusé serait exagéré !!).
Envoyé par cluster26
Partager