Sujet Précédent Sujet Suivant

Copier une table dans une base Access

apkwa - 2 avril 2001 à 14:11
 nazim - 9 avril 2001 à 17:13
Salut tout le monde,

J'ai une base Access qui possède plusieurs tables et je voudrais copier une de ces tables en la renommant (tout en la gardant dans la même base de données).
Quelqu'un peut m'aider ?

Merci !

4 réponses

Réponse 1 / 4
Mariner
2 avril 2001 à 21:41
Voici une de mes fonctions que j'ai modifiée pour toi: 

Public Function RecreerTableV2(ByVal InDB As Database, ByVal DupTable As String, ByVal NvNomTable As String) As Integer
  '
  ' Copie toute la structure de la table DupTable vers NvNomTable
  '
  ' Doit retourner un code tel:
  '   0  : Ok
  '   1  : InDB n'est pas initialisée
  '   4  : DupTable est vide ou invalide
  '   5  : La table DupTable n'existe pas dans InDB
  '   6  : La table DupTable ne contient aucun champs
  '   7  : La table DupTable existe déjà dans OutDB
  '   X  : Voir l'erreur elle-même...
  '
  Dim strTmp1 As String
  Dim tblListeTablesIn As TableDefs
  Dim tblNouvelleTable As TableDef
  Dim tblTableSource As TableDef
  Dim iCmpt As Integer
  Dim fldNouveauChamps As Field
  Dim fldChampsIndex1 As Field
  Dim idxIndexNvTable As Index
  
  
  On Error Resume Next
  
  strTmp1 = InDB.Name
  If (Err.Number > 0) Then
      RecreerTableV2 = 1
      Exit Function
    'Else
  End If
  
  If (DupTable = vbNullString) Then
      RecreerTableV2 = 4
      Exit Function
    'Else
  End If
    
  Set tblListeTablesIn = InDB.TableDefs
  strTmp1 = tblListeTablesIn(DupTable).LastUpdated
  If (Err.Number > 0) Then
      RecreerTableV2 = 5
      Exit Function
    'Else
  End If
  
  If (tblListeTablesIn(DupTable).Fields.Count = 0) Then
      RecreerTableV2 = 6
      Exit Function
    'Else
  End If
    
  strTmp1 = tblListeTablesIn(NvNomTable).LastUpdated
  If (Err.Number = 0) Then
      RecreerTableV2 = 7
      Exit Function
    Else
      Err.Clear
  End If
  
  Set tblTableSource = InDB.TableDefs(DupTable)
  Set tblNouvelleTable = InDB.CreateTableDef(NvNomTable)
  'Recréer les champs avec les propriétés principales...
  For iCmpt = 0 To (tblTableSource.Fields.Count - 1)
    With tblTableSource.Fields(iCmpt)
      Set fldNouveauChamps = tblNouvelleTable.CreateField(.Name, .Type, .Size)
      fldNouveauChamps.Required = .Required      'Valeurs non-Nulle
      fldNouveauChamps.Attributes = .Attributes
    End With
    tblNouvelleTable.Fields.Append fldNouveauChamps
  Next iCmpt
  
  'Le bloc qui suit est pour recréer les "primary key"
  For iCmpt = 0 To (tblTableSource.Indexes.Count - 1)
    strTmp1 = tblTableSource.Indexes(iCmpt).Fields(0).Name
    Set idxIndexNvTable = tblNouvelleTable.CreateIndex(strTmp1)
    idxIndexNvTable.Primary = True
    idxIndexNvTable.Unique = True
    Set fldChampsIndex1 = idxIndexNvTable.CreateField(strTmp1)
    idxIndexNvTable.Fields.Append fldChampsIndex1
    tblNouvelleTable.Indexes.Append idxIndexNvTable
  Next iCmpt

  InDB.TableDefs.Append tblNouvelleTable
  If (Err.Number > 0) Then
      RecreerTableV2 = Err.Number
      Exit Function
    'Else
  End If
  
  
  RecreerTableV2 = 0 'Juste par principe...
End Function


Bien sûr le code est loin d'être parfait, mais il fonctionne très bien. Pour ce qui est des données, c'est une seconde étape.
0
Réponse 2 / 4
apkwa
3 avril 2001 à 10:17
T'en fais pas pour les données, je vais me débrouiller. En tout cas mille mercis pour ton aide (TRES précieuse) !!!!
0
Réponse 3 / 4
nazim
9 avril 2001 à 17:10
-------------------------------
Réponse au message :
-------------------------------

Voici une de mes fonctions que j'ai modifiée pour toi: 

Public Function RecreerTableV2(ByVal InDB As Database, ByVal DupTable As String, ByVal NvNomTable As String) As Integer
  '
  ' Copie toute la structure de la table DupTable vers NvNomTable
  '
  ' Doit retourner un code tel:
  '   0  : Ok
  '   1  : InDB n'est pas initialisée
  '   4  : DupTable est vide ou invalide
  '   5  : La table DupTable n'existe pas dans InDB
  '   6  : La table DupTable ne contient aucun champs
  '   7  : La table DupTable existe déjà dans OutDB
  '   X  : Voir l'erreur elle-même...
  '
  Dim strTmp1 As String
  Dim tblListeTablesIn As TableDefs
  Dim tblNouvelleTable As TableDef
  Dim tblTableSource As TableDef
  Dim iCmpt As Integer
  Dim fldNouveauChamps As Field
  Dim fldChampsIndex1 As Field
  Dim idxIndexNvTable As Index
  
  
  On Error Resume Next
  
  strTmp1 = InDB.Name
  If (Err.Number > 0) Then
      RecreerTableV2 = 1
      Exit Function
    'Else
  End If
  
  If (DupTable = vbNullString) Then
      RecreerTableV2 = 4
      Exit Function
    'Else
  End If
    
  Set tblListeTablesIn = InDB.TableDefs
  strTmp1 = tblListeTablesIn(DupTable).LastUpdated
  If (Err.Number > 0) Then
      RecreerTableV2 = 5
      Exit Function
    'Else
  End If
  
  If (tblListeTablesIn(DupTable).Fields.Count = 0) Then
      RecreerTableV2 = 6
      Exit Function
    'Else
  End If
    
  strTmp1 = tblListeTablesIn(NvNomTable).LastUpdated
  If (Err.Number = 0) Then
      RecreerTableV2 = 7
      Exit Function
    Else
      Err.Clear
  End If
  
  Set tblTableSource = InDB.TableDefs(DupTable)
  Set tblNouvelleTable = InDB.CreateTableDef(NvNomTable)
  'Recréer les champs avec les propriétés principales...
  For iCmpt = 0 To (tblTableSource.Fields.Count - 1)
    With tblTableSource.Fields(iCmpt)
      Set fldNouveauChamps = tblNouvelleTable.CreateField(.Name, .Type, .Size)
      fldNouveauChamps.Required = .Required      'Valeurs non-Nulle
      fldNouveauChamps.Attributes = .Attributes
    End With
    tblNouvelleTable.Fields.Append fldNouveauChamps
  Next iCmpt
  
  'Le bloc qui suit est pour recréer les "primary key"
  For iCmpt = 0 To (tblTableSource.Indexes.Count - 1)
    strTmp1 = tblTableSource.Indexes(iCmpt).Fields(0).Name
    Set idxIndexNvTable = tblNouvelleTable.CreateIndex(strTmp1)
    idxIndexNvTable.Primary = True
    idxIndexNvTable.Unique = True
    Set fldChampsIndex1 = idxIndexNvTable.CreateField(strTmp1)
    idxIndexNvTable.Fields.Append fldChampsIndex1
    tblNouvelleTable.Indexes.Append idxIndexNvTable
  Next iCmpt

  InDB.TableDefs.Append tblNouvelleTable
  If (Err.Number > 0) Then
      RecreerTableV2 = Err.Number
      Exit Function
    'Else
  End If
  
  
  RecreerTableV2 = 0 'Juste par principe...
End Function


Bien sûr le code est loin d'être parfait, mais il fonctionne très bien. Pour ce qui est des données, c'est une seconde étape.

-------------------------------
Réponse au message :
-------------------------------

Salut tout le monde,

J'ai une base Access qui possède plusieurs tables et je voudrais copier une de ces tables en la renommant (tout en la gardant dans la même base de données).
Quelqu'un peut m'aider ?

Merci !
-------------------------------
0
Réponse 4 / 4
nazim
9 avril 2001 à 17:13
j`arrive pas a introduire une info d`un dbgrid a une zone de texte

-------------------------------
Réponse au mess age :
-------------------------------

Voici une de mes fonctions que j'ai modifiée pour toi: 

Public Function RecreerTableV2(ByVal InDB As Database, ByVal DupTable As String, ByVal NvNomTable As String) As Integer
  '
  ' Copie toute la structure de la table DupTable vers NvNomTable
  '
  ' Doit retourner un code tel:
  '   0  : Ok
  '   1  : InDB n'est pas initialisée
  '   4  : DupTable est vide ou invalide
  '   5  : La table DupTable n'existe pas dans InDB
  '   6  : La table DupTable ne contient aucun champs
  '   7  : La table DupTable existe déjà dans OutDB
  '   X  : Voir l'erreur elle-même...
  '
  Dim strTmp1 As String
  Dim tblListeTablesIn As TableDefs
  Dim tblNouvelleTable As TableDef
  Dim tblTableSource As TableDef
  Dim iCmpt As Integer
  Dim fldNouveauChamps As Field
  Dim fldChampsIndex1 As Field
  Dim idxIndexNvTable As Index
  
  
  On Error Resume Next
  
  strTmp1 = InDB.Name
  If (Err.Number > 0) Then
      RecreerTableV2 = 1
      Exit Function
    'Else
  End If
  
  If (DupTable = vbNullString) Then
      RecreerTableV2 = 4
      Exit Function
    'Else
  End If
    
  Set tblListeTablesIn = InDB.TableDefs
  strTmp1 = tblListeTablesIn(DupTable).LastUpdated
  If (Err.Number > 0) Then
      RecreerTableV2 = 5
      Exit Function
    'Else
  End If
  
  If (tblListeTablesIn(DupTable).Fields.Count = 0) Then
      RecreerTableV2 = 6
      Exit Function
    'Else
  End If
    
  strTmp1 = tblListeTablesIn(NvNomTable).LastUpdated
  If (Err.Number = 0) Then
      RecreerTableV2 = 7
      Exit Function
    Else
      Err.Clear
  End If
  
  Set tblTableSource = InDB.TableDefs(DupTable)
  Set tblNouvelleTable = InDB.CreateTableDef(NvNomTable)
  'Recréer les champs avec les propriétés principales...
  For iCmpt = 0 To (tblTableSource.Fields.Count - 1)
    With tblTableSource.Fields(iCmpt)
      Set fldNouveauChamps = tblNouvelleTable.CreateField(.Name, .Type, .Size)
      fldNouveauChamps.Required = .Required      'Valeurs non-Nulle
      fldNouveauChamps.Attributes = .Attributes
    End With
    tblNouvelleTable.Fields.Append fldNouveauChamps
  Next iCmpt
  
  'Le bloc qui suit est pour recréer les "primary key"
  For iCmpt = 0 To (tblTableSource.Indexes.Count - 1)
    strTmp1 = tblTableSource.Indexes(iCmpt).Fields(0).Name
    Set idxIndexNvTable = tblNouvelleTable.CreateIndex(strTmp1)
    idxIndexNvTable.Primary = True
    idxIndexNvTable.Unique = True
    Set fldChampsIndex1 = idxIndexNvTable.CreateField(strTmp1)
    idxIndexNvTable.Fields.Append fldChampsIndex1
    tblNouvelleTable.Indexes.Append idxIndexNvTable
  Next iCmpt

  InDB.TableDefs.Append tblNouvelleTable
  If (Err.Number > 0) Then
      RecreerTableV2 = Err.Number
      Exit Function
    'Else
  End If
  
  
  RecreerTableV2 = 0 'Juste par principe...
End Function


Bien sûr le code est loin d'être parfait, mais il fonctionne très bien. Pour ce qui est des données, c'est une seconde étape.
0

Discussions similaires

[vba] recopier la valeur d'une cellule dans une autre feuille.
cokinoumasterflash -
cokinoumasterflash -

5 réponses
Copier coller valeurs d'une feuille vers une autre feuille à partir de la premiè
talined -
ucfoutu -

10 réponses
copier le contenu d'une table dans une autre
biloutte33 -
imaneinfo1 -

2 réponses
Copier feuille excel dans un autre classeur sans l'ouvrir vb excel
erti1711 -
erti1711 -

4 réponses
Vba coller valeur cellule sur une autre cellule avec variable
walyddu59 -
walyddu59 -

3 réponses
Rejoignez-nous