Public function DateCreation(PTable as string) as Date
On error goto err
Dim DB as DAO.Database
Dim T as DAO.Tabledef
Set DB=CurrentDb
Set T=DB.TableDefs(PTable)
DateCreation=T.DateCreated
Goto fin:
err:
Msgbox "Impossible d\'accéder à la table"
fin:
Set DB=nothing
Set T=nothing
End Function

Public function DateMaj(PTable as string) as Date
On error goto err
Dim DB as DAO.Database
Dim T as DAO.Tabledef
Set DB=CurrentDb
Set T=DB.TableDefs(PTable)
DateMaj=T.LastUpdated
Goto fin:
err:
Msgbox "Impossible d\'accéder à la table"
fin:
Set DB=nothing
Set T=nothing
End Function

Dim LaVariable As Integer

LaVariable = DCount("monChamp","NomTableOuNomRequete")

Currentdb.TableDefs("NomTable").RecordCount

Function RenommerTable(Ancien As String, Nouveau As String) As Boolean
On Error GoTo err:
Dim MCat As New ADOX.Catalog
Dim MTable As ADOX.Table
Set MCat.ActiveConnection = CurrentProject.Connection
Set MTable = MCat.Tables(Ancien)
MTable.Name = Nouveau
RenommerTable = True
err:
Set MCat = Nothing
Set MTable = Nothing
End Function

MsgBox RenommerTable("Produit", "Produit2")

Function SupprimerTable(NomTable As String) As Boolean
On Error GoTo err
Dim MCat As New ADOX.Catalog
Set MCat.ActiveConnection = CurrentProject.Connection
MCat.Tables.Delete (NomTable)
SupprimerTable = True
err:
Set MCat = Nothing
End Function

MsgBox SupprimerTable("test")

Public Function xKillLinks() 

Dim BD As DAO.Database 
Set BD = CurrentDb 
Dim tb As DAO.TableDef 
For Each tb In BD.TableDefs 
    If left(tb.name, 4) <> "MSys" Then 
        If Len(tb.connect) > 0 Then 
            DoCmd.RunSQL "DROP TABLE [" & tb.name & "] ;" 
            Debug.Print "effacement de " & tb.name & " -=#=> " & tb.connect 
        End If 
    End If 
Next tb 

End Function 

Function ExistTable2( ByVal strTabl As String) As Boolean
    Dim str As String
    On Error GoTo err01
    str = CurrentDb.TableDefs(strTabl).name
    ExistTable2= True
    Exit Function
err01:
    Select Case Err.Number
        Case 3265
            ExistTable2 = False
    End Select
End Function 

Function ExisteTable(NomTable As String) As Boolean
On Error GoTo err:
Dim MCat As New ADOX.Catalog
Dim MTable As ADOX.Table
Set MCat.ActiveConnection = CurrentProject.Connection
Set MTable = MCat.Tables(NomTable)
ExisteTable = True
err:
Set MCat = Nothing
Set MTable = Nothing
End Function

Debug.print ExisteTable("Produit")

Sub Insertion(oRst1 As DAO.Recordset, orst2 As DAO.Recordset)
On Error GoTo err
  Dim Fld As DAO.Field
    orst2.AddNew
    For Each Fld In oRst1.Fields
      If (Fld.Attributes And dbAutoIncrField) = 0 Then
        orst2.Fields(Fld.Name).Value = Fld.Value
      End If
    Next Fld
    orst2.Update
err:
End Sub

Sub copier()
Dim NomTable1 As String, NomTable2 As String
Dim oRst1 As DAO.Recordset, orst2 As DAO.Recordset
Dim odb As DAO.Database
Dim Message As String
Set odb = currentdb
NomTable1 = "TblClient"
NomTable2 = "TblClientSansDoublons"
Set oRst1 = odb.OpenRecordset(NomTable1)
Set orst2 = odb.OpenRecordset(NomTable2)
While Not oRst1.EOF
  Insertion oRst1, orst2
  oRst1.MoveNext
Wend
If Not orst2.EOF Then orst2.MoveLast
Message = "Opération terminée" & vbCrLf & vbCrLf & _
          "La table source comportait : " & oRst1.RecordCount & " enregistrement(s)," & vbCrLf & _
          "la table de destination en comporte " & orst2.RecordCount
MsgBox Message, vbInformation, "MAJ terminée"
End Sub

Function Ouvrir_Table_Exclusif (Bd As Database, Ma_Table As String) As Integer
Dim rcd As DAO.Recordset
On Error GoTo Erreur
Set rcd = Bd.OpenRecordset(Ma_Table, dbOpenTable, dbDenyRead) 
 ' -- Mes traitemens en mode exclusif
Rcd.Close
Set rcd = Nothing
Exit Function
Erreur:
Msgbox Err.Number & vbcrlf & Err.Description
End Function

Sub lier()
Dim strMotPasse As String
Dim strCheminBd As String
Dim strNomTable As String
Dim strConnect As String
Dim oDb As DAO.Database
Dim oTbl As DAO.TableDef
'Définit mot passe, nom table, chemin base de données
strMotPasse = "pass"
strCheminBd = "c:\test.mdb"
strNomTable = "Table1"
'Instancie l'objet Database
Set oDb = CurrentDb
'Définit la chaine de connexion permettant la liaison
strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=C:\test.mdb"
'Crée la nouvelle table
Set oTbl = oDb.CreateTableDef(strNomTable)
With oTbl
    .Connect = strConnect
    .SourceTableName = strNomTable
End With
'Ajoute la table à la base de données
oDb.TableDefs.Append oTbl: oDb.TableDefs.Refresh
End Sub

Sub lierToutes()
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
'Définit mot passe, nom table, chemin base de données
strMotPasse = "pass"
strCheminBd = "c:\test.mdb"
'Définit la chaine de connexion permettant la liaison des tables
strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=C:\test.mdb"
'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
    'ignore les tables system
    If (oTblSource.Attributes And dbSystemObject) = 0 Then
        strTemp = strTemp & oTblSource.Name & "|"
    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)
  '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
Next i
 
'Rafraichit la liste des tables
oDb.TableDefs.Refresh
End Sub

Dim db As DAO.Database
Dim rs As DAO.Recordset

On Error GoTo ILT_Err

Set db = CurrentDb()
Set rs = db.OpenRecordset(strTbl, dbOpenTable, dbDenyWrite, dbOptimistic)

rs.Close

IsLockedTable = False

ILT_End:
Set rs = Nothing
Set db = Nothing
Exit Function

ILT_Err:
Select Case Err.Number
    Case 3008
        ' la table est verrouillée par un autre processus
        IsLockedTable = True
        GoTo ILT_End
    Case Else
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
        IsLockedTable = True
        GoTo ILT_End
End Select
End Function

Public Sub Chemin_Tables()

Dim cnDB    As New ADODB.Connection
Dim catDB   As New ADOX.Catalog
Dim tblDB   As ADOX.Table
 
    Set cnDB = CurrentProject.Connection
    Set catDB.ActiveConnection = cnDB
        
     
      For Each tblDB In catDB.Tables
        If tblDB.Type = "LINK" Then
            Debug.Print tblDB.Name
            Debug.Print tblDB.Properties("Jet OLEDB:Link Datasource")
        End If
      Next
     
    cnDB.Close
    Set cnDB = Nothing
    Set tblDB = Nothing
    Set catDB = Nothing

End Sub

Sub PrimaryKeyX()

Dim catNorthwind As New ADOX.Catalog
Dim tblNew As New ADOX.Table
Dim idxNew As New ADOX.Index
Dim idxLoop As New ADOX.Index
Dim colLoop As New ADOX.Column

' Relier le catalogue
catNorthwind.ActiveConnection="Provider=Microsoft.Jet.OLEDB.4.0;" & _
"data source=c:\Program Files\" & _
"Microsoft Office\Office\Samples\Northwind.mdb;"

' Nommer nouvelle table  
tblNew.Name = "NewTable"

' Apposer un champ numérique et des textes à la nouvelle table.
tblNew.Columns.Append "NumField", adInteger, 20
tblNew.Columns.Append "TextField", adVarWChar, 20

' Apposer le nouvel index principal primaire sur la colonne de NumField 
' à la nouvelle table 
idxNew.Name = "NumIndex"
idxNew.Columns.Append "NumField"
idxNew.PrimaryKey = True
idxNew.Unique = True
tblNew.Indexes.Append idxNew

' Apposer un index sur Textfield à la nouvelle table. 
' Noter la technique différente : Indication de l'index 
' et du nom de colonne comme paramètres de la méthode d'apposer 
tblNew.Indexes.Append "TextIndex", "TextField"

' Apposer la nouvelle table 
catNorthwind.Tables.Append tblNew

With tblNew

Debug.Print tblNew.Indexes.Count & " Indexes in " & _
tblNew.Name & " Table"

' Énumérer la collection d'index. 
For Each idxLoop In .Indexes

With idxLoop
Debug.Print "Index " & .Name
Debug.Print " Primary key = " & .PrimaryKey
Debug.Print " Unique = " & .Unique

' Énumérer la collection de colonnes de chaque objet d'index.
Debug.Print " Columns"
For Each colLoop In .Columns
Debug.Print " " & colLoop.Name
Next colLoop

End With

Next idxLoop

End With

' Supprimer la nouvelle table car c'est une démonstration 
catNorthwind.Tables.Delete tblNew.Name
Set catNorthwind = Nothing

End Sub

Dim Db as DAO.Database
Set Db=CurrentDb
Db.Tabledefs("MaTable").RefreshLink

select * into NouvTable from AncienneTable;

ALTER TABLE MaTable ADD COLUMN NouvColonne Text(255) 
UPDATE MaTable SET NouvColonne = VieilleColonne 
ALTER TABLE MaTable DROP COLUMN VieilleColonne

Function Delete_Table(NomTable As String) As Boolean
    Dim db As DAO.Database
    Dim tbl As DAO.TableDef
    Delete_Table = False
        
    Set db = CurrentDb
    
    For Each tbl In db.TableDefs
        If tbl.Name = NomTable Then
            db.TableDefs.Delete (tbl.Name)
            Delete_Table = True
        Else
            Delete_Table = False
        End If
    Next tbl
    
End Function

Dim tbl As String
    
    tbl = "Table1"
    
    If Delete_Table(tbl) = True Then
        MsgBox "La table " & tbl & " a bien été éffacée."
    Else
        MsgBox "Aucune table portant le nom de " & tbl & " a été trouvée."
    End If