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
|
Public Function attachT(ByVal strtable As String, strConnect As String, strSourceTable As String) As Boolean
' Attache une table à la base de données courante, paramètres :
' strtable : nom local de la table à créer
' strconnect : localisation de la base où trouver la table à attacher
' strsourcetable : nom de la table dans la base source
On Error GoTo Err_attachT
Dim dbsTemp As Database
Dim tdfLinked As TableDef
Dim rstLinked As Recordset
Dim intTemp As Integer
Dim endroit As String
endroit = ";DATABASE=" & strConnect
Set dbsTemp = CurrentDb
' Crée un objet TableDef, définit ses propriétés
' Connect et SourceTableName en fonction des
' arguments passés et ajoute l'objet à la collection TableDefs.
Set tdfLinked = dbsTemp.CreateTableDef(strtable)
tdfLinked.Connect = endroit
tdfLinked.SourceTableName = strSourceTable
dbsTemp.TableDefs.Append tdfLinked
' table attachée ?
If table_existe(strtable) <> "no found" Then
attachT = True
Else
attachT = False
End If
Exit Function
Err_attachT:
attachT = False
Exit Function
End Function
Public Function detachT(ByVal strtable As String) As Boolean
' Supprime l'attache d'une table dont le nom est passé en paramètre
' si la table n'existe pas, inutile d'aller plus loin
If table_existe(strtable) = "no found" Then
detachT = True
Exit Function
End If
On Error GoTo Err_detachT
Dim dbsTemp As Database
Set dbsTemp = CurrentDb
dbsTemp.TableDefs.Delete strtable
Set dbsTemp = Nothing
' table détachée ?
If table_existe(strtable) = "no found" Then
detachT = True
Else
detachT = False
End If
Exit Function
Err_detachT:
Set dbsTemp = Nothing
detachT = False
Exit Function
End Function
Public Function table_existe(ByVal strtable As String)
' Est-ce que la table donnée existe dans la base courante ?
On Error GoTo err_table_existe
Dim dbs As Database, tdfLoop As TableDef, strrep As String
Set dbs = CurrentDb
strrep = "no found"
For Each tdfLoop In dbs.TableDefs
If UCase(tdfLoop.Name) = UCase(strtable) Then
strrep = strtable
Exit For
End If
Next tdfLoop
Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = strrep
Exit Function
err_table_existe:
Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = "error"
End Function |
Partager