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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
| Private Sub SupprimerLesTablesLiées()
Dim tb As DAO.TableDef
Dim rst As DAO.Recordset
Exit Sub
Set rst = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Connection_Table", dbOpenSnapshot)
While Not rst.EOF
For Each tb In CurrentDb.TableDefs
If tb.Name = rst("Table") Then
DoCmd.RunSQL "DROP TABLE [" & tb.Name & "] ;"
End If
Next tb
rst.MoveNext
Wend
Set tb = Nothing
rst.Close: Set rst = Nothing
End Sub
Public Function MS_Connection_Refresh() As Boolean
Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim MonChemin As String
Exit Function
MS_Connection_Refresh = True
Call SupprimerLesTablesLiées
DoCmd.RunSQL "Update Tbl_Connection set UnSuccess=False"
Set rst = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Connection", dbOpenSnapshot)
While Not rst.EOF
If Left(rst("Path"), 2) = ".\" Then
MonChemin = CurrentProject.Path & Right(rst("Path"), Len(rst("Path")) - 1)
Else
MonChemin = rst("Path")
End If
If existeFileFSO(MonChemin) Then
Set rst2 = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Connection_Table WHERE Connection=" & rst("ID"), dbOpenSnapshot)
While Not rst2.EOF
Call MS_LinkOneTable(MonChemin, rst2("Table"))
rst2.MoveNext
Wend
Else
DoCmd.RunSQL "Update Tbl_Connection set UnSuccess=True WHERE ID=" & rst("ID")
'MsgBox "files not found: " & MonChemin
MS_Connection_Refresh = False
End If
rst.MoveNext
Wend
End Function
Public Function existeFileFSO(ByVal Fichier As String) As Boolean
Dim FS As FileSystemObject
Set FS = CreateObject("Scripting.FileSystemObject")
existeFileFSO = FS.FileExists(Fichier)
Set FS = Nothing
End Function
Public Sub MS_LinkOneTable(MonChemin As String, MyTable As String)
Dim strMotPasse As String
Dim strCheminBd As String
Dim strConnect As String
Dim strNomsTables() As String
Dim strTemp As String
Dim i As Integer
Dim oDb As DAO.Database
Dim oDbSource As DAO.Database
Dim oTbl As DAO.TableDef
Dim oTblSource As DAO.TableDef
strMotPasse = "pass"
strCheminBd = MonChemin
'Définit la chaine de connexion permettant la liaison des tables
strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=" & strCheminBd
'Instancie l'objet Database de la base courante
Set oDb = CurrentDb
'Instancie l'objet Database de la base protégée
Set oDbSource = DBEngine.OpenDatabase(strCheminBd, True, True, strConnect)
'Parcours l'ensemble des tables de la base de données protégée
'et stocke leur nom
For Each oTblSource In oDbSource.TableDefs
If (oTblSource.Attributes And dbSystemObject) = 0 Then
If Len(oTblSource.Connect) = 0 Then
strTemp = strTemp & oTblSource.Name & "|"
End If
End If
Next
'Ferme la base de données sources (impératif pour la liaison)
oDbSource.Close: Set oDbSource = Nothing
'parcours le tableau de noms de tables
strNomsTables = Split(Left(strTemp, Len(strTemp) - 1), "|")
For i = 0 To UBound(strNomsTables)
' MsgBox strNomsTables(i)
If strNomsTables(i) = MyTable Then
' If Left(strNomsTables(i), 3) = MonPrefixe Then
'Crée une nouvelle table dans la base de données courante
Set oTbl = oDb.CreateTableDef(strNomsTables(i))
'Lie les deux tables
oTbl.Connect = strConnect
oTbl.SourceTableName = strNomsTables(i)
'Ajoute la table à la base de données
oDb.TableDefs.Append oTbl
End If
Next i
'Rafraichit la liste des tables
oDb.TableDefs.Refresh
End Sub |
regrouper les informations de plusieurs dorsales en une dorsale mère.
Répondre avec citation
Partager