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
| Sub importation_base()
On Error GoTo err:
Dim db As DAO.Database
Dim rst As New Recordset
'Dim rst2 As New Recordset
Dim requete As String
Dim requete2 As String
Dim R8 As String
Set db = CurrentDb
requete = InputBox("rentrer le nom de la table à importer")
If requete = "" Then End
R1 = requete
requete = "SELECT * from " & requete
With rst
Set .ActiveConnection = CurrentProject.Connection
.CursorType = adOpenKeyset
.Open requete
R1 = MsgBox("cette table a déja été importé, voulez vous en importer une autre", vbYesNo)
End With
If R1 = 6 Then
importation_base
Else
End
End If
rst.Close
End
err:
requete2 = "CREATE TABLE [dbo].[" & R1 & " ] ([Ctc_Code] [int]PRIMARY KEY IDENTITY (1, 1) NOT NULL ,[Ctc_Fk_Code_Entreprise] [int] NOT NULL ,[Ctc_Nom] [varchar] (40) NOT NULL ,[Ctc_Prenom] [varchar] (40) NULL ,[Ctc_Titre] [varchar] (4) NULL ,[Ctc_Tel] [varchar] (20) NULL ,[Ctc_Fax] [varchar] (20) NULL ,[Ctc_Portable] [varchar] (20) NULL ,[Ctc_Email] [varchar] (50) NULL ,[Ctc_Nom_Assistant] [varchar] (50) NULL ,[Ctc_Tel_Assistant] [varchar] (20) NULL ,[Ctc_Fk_Code_Fonction] [varchar] (10) NOT NULL ,[Ctc_Remarque_Fonction] [varchar] (150) NULL ,[Ctc_Notes] [varchar] (144) NULL ,[Ctc_Date_Creation] [datetime] NOT NULL ,[Ctc_Date_Maj] [datetime] NOT NULL ,[Ctc_Auteur] [int] NULL ,[Ctc_Inactif] [bit] NOT NULL ,[Ctc_Stagiaire] [bit] NOT NULL ,[Ctc_Lotus] [bit] NOT NULL ,[Ctc_NPAI_Mail] [bit] NOT NULL ,[Ctc_Origine_des_bases] [varchar] (25) NOT NULL ,[Ctc_NPAI_Courrier] [bit] NOT NULL ,[info_sup1] [varchar] (200) NULL ,[info_sup2] [varchar] (200) NULL ,[info_sup3] [varchar] (200) NULL ) ON [PRIMARY]"
With rst
Set .ActiveConnection = CurrentProject.Connection
.CursorType = adOpenKeyset
.Open requete2
End With
R8 = OuvrirUnFichier(0, "Sélection d'un fichier", 1, "Fichier Excel", "xls", "C:")
DoCmd.TransferSpreadsheet acImport, 6, R1, R8, False
End Sub |