Discussion :

[franckimmo]

Bonjour à tous,

J'ai une base de données "Base de données1" et je souhaiterai dans une procédure en VBA créer une nouvelle table ("Tbl1") et par la même occasion créer 11 champs, un champ index ("tbl1ID"), un champ texte ("tbl1Nom"), un champ Date ("Tbl1Date"), un champ numérique ("Tbl1Loyer") et un champ Boléen ("Tbl1Adsl")
Y a t'il quelqu'un qui peut m'aider.
Merci à vous et bonne journée

[Invité]

Bonjour

As-tu consulté cet excellent tutoriel sur DAO ?

Comme cette partie : 4.4.4.3. Créer un champ

Philippe

[franckimmo]

Bonjour,
Merci pour ton renseignement, il y a de la matière. J'ai une autre question
Comment faire pour supprimer une table si elle existe déjà et sinon la créer.
Pour l'intant mon code ne fonctionne pas si tu as une idée merci d'avance. Ci-joint le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Private Sub Bascule0_Click()
Dim oDb As DAO.Database
Dim oNouvelleTable As DAO.TableDef
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
Dim Clients As TableDef
 
'supprime une table existante
'Si tbl=nothing alors tbl est la cause de l'erreur
 If Clients = Nothing Then
 
     Set oDb = CurrentDb()
'Crée la nouvelle table
    Set oNouvelleTable = oDb.CreateTableDef("Clients")
'Crée le champ IDClient
    Set oChamp = oNouvelleTable.CreateField("IDClient", dbLong)
'Définit le champ en numero_auto
    oChamp.Attributes = dbAutoIncrField
'Ajoute le champ à la table
    oNouvelleTable.Fields.Append oChamp
'Crée le champ nomClient et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("CodeClient", _
        dbText, 15)
'Crée le champ PrenomClient et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Agence", _
        dbText, 25)
'définit la clé primaire sur l'IDClient
    Set oIndex = oNouvelleTable.CreateIndex("PK_IDClient")
    oIndex.Primary = True
    oIndex.Fields.Append oIndex.CreateField("IdClient")
'Ajoute l'index à la table
    oNouvelleTable.Indexes.Append oIndex
'Ajoute la table à la base de données
    oDb.TableDefs.Append oNouvelleTable
 
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNouvelleTable = Nothing
Set oDb = Nothing
CurrentDb.TableDefs.Refresh
 
 
 
 
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
 
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open("C:\Loyers_Développez_2007_3.xlsm")
Set oWSht = oWkb.Worksheets("Cible")
'premier ligne ou on commence l'import
I = 1
 
'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False
 
'tant que la cellule n'est pas vide
While oWSht.Range("A" & I).Value <> ""
 
  cSQL = "insert into [Clients] ( [CodeClient], [Agence]) values (" & Chr(34) & oWSht.Cells(I, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(I, 3) & Chr(34) & ")"
 ',[Champ3], [Champ4],[Champ5], [Champ6],[Champ7], [Champ8],[Champ9],[Champ10],[Champ11],[Champ12]
'exécute la requète
DoCmd.RunSQL (cSQL)
 
 
  I = I + 1
Wend
 
DoCmd.SetWarnings True
 
Set oWkb = Nothing
 
 
  Else
 
       DoCmd.DeleteObject acTable, "Clients"
    Set oDb = CurrentDb()
'Crée la nouvelle table
    Set oNouvelleTable = oDb.CreateTableDef("TblClients")
'Crée le champ IDClient
    Set oChamp = oNouvelleTable.CreateField("IDClient", dbLong)
'Définit le champ en numero_auto
    oChamp.Attributes = dbAutoIncrField
'Ajoute le champ à la table
    oNouvelleTable.Fields.Append oChamp
'Crée le champ nomClient et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("CodeClient", _
        dbText, 15)
'Crée le champ PrenomClient et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Agence", _
        dbText, 25)
'définit la clé primaire sur l'IDClient
    Set oIndex = oNouvelleTable.CreateIndex("PK_IDClient")
    oIndex.Primary = True
    oIndex.Fields.Append oIndex.CreateField("IdClient")
'Ajoute l'index à la table
    oNouvelleTable.Indexes.Append oIndex
'Ajoute la table à la base de données
    oDb.TableDefs.Append oNouvelleTable
 
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNouvelleTable = Nothing
Set oDb = Nothing
 
 
 
''Dim MaBD As Database
'Dim MonSQL As String
'DoCmd.Requery
' detruit la table TransfertCegecom
''DoCmd.DeleteObject acTable, "Clients"
'Set MaBD = CurrentDb()
'MonSQL = " SELECT ,champ4 as Num_Appel, [Duration HH:MM:SS] as Durée,[Amount   EUR] as MontantCegecom INTO "Transfert" FROM TABLE3;"
'MonSQL = MonSQL &
'MaBD.Execute "SELECT TABLE3.* INTO " _
    '    & "[TransfertdeCegecom] FROM TABLE3;"
'DoCmd.Requery
 
 
'MaBD.Execute MonSQL
'MsgBox "La création de la nouvelle table s'est déroulée avec succès. " & MaBD.RecordsAffected & " enregistrements", vbInformation, "Opération réussie"
 
 'la syntaxe suivante rafrîchit la base de donnée
CurrentDb.TableDefs.Refresh
 
 
 
 
'Dim oApp As Excel.Application ???????
'Dim oWkb As Excel.Workbook ???????
'Dim oWSht As Excel.Worksheet ??????
 
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open("C:\Loyers_Développez_2007_3.xlsm")
Set oWSht = oWkb.Worksheets("Cible")
'premier ligne ou on commence l'import
I = 1
 
'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False
 
'tant que la cellule n'est pas vide
While oWSht.Range("A" & I).Value <> ""
 
  cSQL = "insert into [TblClients] ( [CodeClient], [Agence]) values (" & Chr(34) & oWSht.Cells(I, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(I, 3) & Chr(34) & ")"
 ',[Champ3], [Champ4],[Champ5], [Champ6],[Champ7], [Champ8],[Champ9],[Champ10],[Champ11],[Champ12]
'exécute la requète
DoCmd.RunSQL (cSQL)
 
 
  I = I + 1
Wend
 
DoCmd.SetWarnings True
 
Set oWkb = Nothing
 
    End If
End Sub

[FreeAccess]

Bonjour,

Comment faire pour supprimer une table si elle existe déjà.....

[franckimmo]

Bonjour à tous,

Je remercie FreeAccess et Philippe JOCHMANS de leur aide pour la conception de ce code. Il est certain que pour supprimer une table déjà existante il est préférable d'utiliser une fonction. Ci-dessous la fonction à utiliser. Bien sûr lors du déclenchement du code en cliquant sur un bouton bascule il faudra appeler cette fonction. Non verrons cela après la fonction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
            CurrentDb.TableDefs.Refresh
        Else
            Delete_Table = False
        End If
    Next tbl
 
End Function

Le code ci-dessous permet d'importer des données stockées dans Exell 2007 en extension.xlsm dans une base de données Access 2007.
La première instruction c'est donc de savoir si la table "Clients" existe déjà ou pas. c'est le but de la fonction. Si elle existe déjà elle sera donc supprimée sinon elle sera créée.
Quand viendra le moment de la créée une syntaxe est appliquée pour créer un champ indexé "IDClient" en numéro auto, quatre champs texte "CodeClient", "Agence", "Nom, "Caution".
Ces champs se verront attribuer les valeurs stockées dans Exell, sheets "Cible"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Private Sub Bascule0_Click()
Dim oDb As DAO.Database
Dim oNouvelleTable As DAO.TableDef
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
Dim Clients As TableDef
Dim tbl As String
Dim DateEntrée As Date
Dim DateSortie As Date
 
    tbl = "TblClients"
' J'introduis la fonction "Delete_Table"
If Delete_Table(tbl) = True Then
        MsgBox "La table " & tbl & " doit être éffacée."
        CurrentDb.TableDefs.Refresh
 
 
     Set oDb = CurrentDb()
'Crée la nouvelle table
    Set oNouvelleTable = oDb.CreateTableDef("TblClients")
'Crée le champ IDClient
    Set oChamp = oNouvelleTable.CreateField("IDClient", dbLong)
'Définit le champ en numero_auto
    oChamp.Attributes = dbAutoIncrField
'Ajoute le champ à la table
    oNouvelleTable.Fields.Append oChamp
'Crée le champ CodeClient et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("CodeClient", _
        dbText, 15)
'Crée le champ Agence et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Agence", _
        dbText, 25)
       ' Crée le champ Nom et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Nom", _
        dbText, 35)
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Caution", _
    dbText, 30)
 
'définit la clé primaire sur l'IDClient
    Set oIndex = oNouvelleTable.CreateIndex("PK_IDClient")
    oIndex.Primary = True
    oIndex.Fields.Append oIndex.CreateField("IdClient")
'Ajoute l'index à la table
    oNouvelleTable.Indexes.Append oIndex
'Ajoute la table à la base de données
    oDb.TableDefs.Append oNouvelleTable
 
 
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNouvelleTable = Nothing
Set oDb = Nothing
CurrentDb.TableDefs.Refresh
'Met en route la procédure d'inportation
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
 
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open("C:\Loyers_Développez_2007_3.xlsm")
Set oWSht = oWkb.Worksheets("Cible")
'premiere ligne ou on commence l'import
i = 2
 
'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False
 
'tant que la cellule n'est pas vide
While oWSht.Range("A" & i).Value <> ""
 
  cSQL = "insert into [TblClients]"
  cSQL = cSQL + "( [CodeClient], [Agence], [Nom], [Caution], [DateEntrée],[DateSortie]) values"
  cSQL = cSQL + "(" & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & ", " & Chr(34)
  cSQL = cSQL + oWSht.Cells(i, 4) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 5) & Chr(34)
  cSQL = cSQL + oWSht.Cells(i, 6) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 7) & Chr(34) & ")"
 '& ", " & Chr(34) & oWSht.Cells(i, 5) & Chr(34)
 
'exécute la requète
DoCmd.RunSQL (cSQL)
 
 
  i = i + 1
Wend
CurrentDb.TableDefs.Refresh
MsgBox "Une nouvelle table " & tbl & " va être créée."
DoCmd.SetWarnings True
 
Set oWkb = Nothing
 
   Else
 
    Set oDb = CurrentDb()
'Crée la nouvelle table
    Set oNouvelleTable = oDb.CreateTableDef("TblClients")
    MsgBox "La table portant le nom de " & tbl & " va être créée."
'Crée le champ IDClient
    Set oChamp = oNouvelleTable.CreateField("IDClient", dbLong)
'Définit le champ en numero_auto
    oChamp.Attributes = dbAutoIncrField
'Ajoute le champ à la table
    oNouvelleTable.Fields.Append oChamp
'Crée le champ CodeClient et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("CodeClient", _
        dbText, 15)
'Crée le champ Agence et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Agence", _
        dbText, 25)
'définit la clé primaire sur l'IDClient
    Set oIndex = oNouvelleTable.CreateIndex("PK_IDClient")
    oIndex.Primary = True
    oIndex.Fields.Append oIndex.CreateField("IdClient")
'Ajoute l'index à la table
    oNouvelleTable.Indexes.Append oIndex
'Ajoute la table à la base de données
    oDb.TableDefs.Append oNouvelleTable
 
 
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNouvelleTable = Nothing
Set oDb = Nothing
 
 'la syntaxe suivante rafrîchit la base de donnée
CurrentDb.TableDefs.Refresh
 
'Met en route la procédure d'inportation
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open("C:\Loyers_Développez_2007_3.xlsm")
Set oWSht = oWkb.Worksheets("Cible")
'premier ligne ou on commence l'import
i = 1
 
'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False
 
'tant que la cellule n'est pas vide
While oWSht.Range("A" & i).Value <> ""
 
  cSQL = "insert into [TblClients]"
  cSQL = cSQL + "( [CodeClient], [Agence]) values"
  cSQL = cSQL + "(" & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & ")"
 
'exécute la requète
DoCmd.RunSQL (cSQL)
 
 
  i = i + 1
Wend
 
DoCmd.SetWarnings True
 
Set oWkb = Nothing
 
    End If
End Sub

Voilà en quoi sert ce code. Si des questions vous viennet à l'esprit et si je peux y répondre je vous les fournirai avec grand plaisir.
Encore une fois un grand merci à tout ceux qui m'ont aidé.
Une bonne journée à tous
Franck