[VB] Connexion à une BDD Access

Dim BDD As ADODB.Connection 
Dim recSet As ADODB.Recordset 
Dim cSQL As String 

Set BDD = New ADODB.Connection 
Set recSet = New ADODB.Recordset

'La chaine connection
chaine = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\Nant\Desktop\MABDD.mdb;Persist Security Info=False"

'On créé la connexion
BDD.Open chaine

'On écrit la requête
cSQL = "CREATE TABLE Test (Nom varchar(60),Prenom varchar(60),Mail varchar(60),Surnom varchar(60),DateAjout date not null)" 

'On passe la requete à la base
recSet.Open cSQL, BDD, , , adCmdText

'On ferme la connexion et on libère les objets
BDD.Close
recSet.Close

Set BDD = Nothing
Set recSet = Nothing

Sub insert() 

            
    'Ici l'importation se déclenche en cliquant sur le bouton "Insert" 
    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:\Users\Nant\Desktop\JeuDeTest2.xls") 'chemin vers le fichier Excel 
    Set oWSht = oWkb.Worksheets("Feuill1") 'nom de la feuille qui contient les données à importer 
      
    'première ligne ou commence l'import, on ne prend pas la 1ère vu qu'il s'agit des noms de champ (valable pour mon cas, pas forcément pour tous) 
    i = 2 
      
    'pour éviter les messages lors de l'ajout des enregistrements 
    DoCmd.SetWarnings False 
     
     
    'requête de création de table et... 
    cSQLCreateTable = "CREATE TABLE CarnetTest(Champ1  varchar(60),Champ2 varchar(60),Champ3 varchar(60),Champ4 varchar(60),Champ5 date);" 
    '...son exécution 
     DoCmd.RunSQL cSQLCreateTable 
     
    'on arrête l'importation quand le programme rencontre une case vide dans le champs "Champ3" / colonne C indice "i"(champs toujours rempli avec Champ5 qui est une date, celui ci choisi car plus judicieux) 
    While oWSht.Range("C" & i).Value <> "" 
      
        'requète SQL (avec en paramètre la ligne i et le numéro de la colonne comme précisé au-dessus) 
         cSQL = "insert into [Feuill1] ( [Champ1], [Champ2], [Champ3], [Champ4], [Champ5] ) values (" & Chr(34) & oWSht.Cells(i, 1) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 4) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 5) & Chr(34) & ")" 
        'ici, on ne prend que les colonnes A (=1) et B (=2) etc. 
        'exécution de la requète 
        DoCmd.RunSQL cSQL 
         
        'on incrémente la variable i pour passer à la ligne suivante 
        i = i + 1 
      
    Wend 
         
    'on averti l'utilisateur que la Table est créée. 
    MsgBox "Table Access créée sur la Base de données MABDD.mdb . Pensez à l'archiver dans un Dossier." 
     
     
End Sub 

ThisWorkbook.Save

ThisWorkbook.SaveAs("C:\monDossier\nouveauNom.xls")

# If ErrorNumber = 3704 Then
# fCancelDisplay = True
# End If

# Private Sub Data1_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
# If ErrorNumber = 3704 Then
# fCancelDisplay = True
# End If
# End Sub

If Err.Number <> 0 Then
     MsgBox "Connexion à la base impossible",VbExclamation,"ERREUR BDD"
     Exit Sub
End If

Sub cnxBDD()  
    'Il faut ajouter la référence Microsoft ActiveX Data Objects x.x Library au projet pour que la connexion marche  
    'Dans le menu de l'éditeur VB => Outils => Références ... cocher la case qui correspond. ici 9.0  

    Dim BDD As ADODB.Connection 'déclaration variable Base De Données pour la connex  
    Dim recSet As ADODB.Recordset 'declaration du recordset => variable contenant le résultat d'une requète sous forme de tableau  
    Dim cSQL As String 'variable contenant la requete SQL  

    Set BDD = New ADODB.Connection 'initialisation des variables [SET]  
    Set recSet = New ADODB.Recordset  
    On Error Resume Next 'voir note plus bas pour les explications  
      
    'La chaine connection  
    chaine = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\Nant\Desktop\MABDD.mdb;Persist Security Info=False"  

    'On créé la connexion  
    BDD.Open chaine  
      
      
    'la requête  
    cSQL = "CREATE TABLE Test (Champ1  varchar(60),Champ2 varchar(60),Champ3 varchar(60),Champ4 varchar(60),Champ5 date not null)"  
      
    'On passe la requete à la base  
    recSet.Open cSQL, BDD, , , adCmdText  
      

    '///////////////////////////////////////////  
    '///// CODE POUR INSERTION DANS LA BDD /////  
    '///////////////////////////////////////////  
      
    'A FINIR FINIR  
      
    '///////////////////////////////////////////  
    '////////////////FIN DU ////////////////////  
    '///// CODE POUR INSERTION DANS LA BDD /////  
    '///////////////////////////////////////////  
      
      
      

    'On ferme la connexion et on libère les objets  
    BDD.Close  
    recSet.Close  
      
    Set BDD = Nothing  
    Set recSet = Nothing  
      
      
      
    'If Err.Number <> 0 Then  
     'MsgBox "Connexion à la base impossible", vbExclamation, "ERREUR BDD"  
     'Exit Sub  
    'End If  

End Sub  

'Une erreur 3704 peut se produire car "Le fournisseur ODBC SQL Server (MSDASQL) ne fournit pas informations  
'sur les résultats des instructions SQL individuelles au sein d'une procédure stockée. Le seul résultat qui  
'proviennent de retour d'une exécution d'une procédure stockée est le résultat de l'instruction SELECT si  
'elle possède un."  

'on peut "cacher" l erreur, ça fait crade mais je n'ai trouvé que ça :  
'pour cette raison qu'il y a la présence en haut du ON ERROR ...  


Sub Data1_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)  
    If ErrorNumber = 3704 Then  
    fCancelDisplay = True  
    End If  
End Sub