Import excel dans access

Sub archiver_Access()
Dim conn As Object
Dim requete As Object
Dim f_num As Long, f_date As Date, c_num As String, e_date As Date, totalHT As Double
Dim base_ac As String, fichier As String, texte_SQL As String

'---------collecte les infos de la facture
f_num = Range("A14")
f_date = Range("A16")
c_num = CStr(Range("C16"))
e_date = Range("H16")
totalHT = Range("F43")

'-------connexion à la base dans fichier archives.xls
base_ac = "Suivi_affaire.mdb" 'a adapter
fichier = ThisWorkbook.Path & "\" & base_ac 'a adapter
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
                "data source=" & fichier & ";"
                
'----------- travail demandé: insère dans les champs de "T_archive les données collectées
texte_SQL = "INSERT INTO T_archive (num_fact,dat_fact,num_comm,echeance,montant_HT) VALUES ('" & (f_num) & "','" & (f_date) & "', '" & (c_num) & "','" & (e_date) & "', '" & (totalHT) & "')"
' éxécute le travail demandé
Set requete = CreateObject("ADODB.recordset")
On Error GoTo alerte 'cas où la facture (numéro) a déjà été enregistrée
Set requete = conn.Execute(texte_SQL)

'---------------déroulement normal
MsgBox "archivage de la facture n° " & f_num & " effectué avec succès"
Set requete = Nothing
Set conn = Nothing
Exit Sub

'------------- gestionnaire erreurs
' facture déjà enregistrée
alerte:
MsgBox "la facture n° " & f_num & " a déjà été enregistrée!", vbCritical
Set requete = Nothing
Set conn = Nothing
End Sub

Sub DataExcel_Access()
    Dim Rsxl As ADODB.Recordset, r As Long
    Dim rs As Recordset
    Dim cnxl As ADODB.Connection
    Dim Cd As ADODB.Command
    
    Set db = CurrentDb
    ' open a recordset: nom de table a adapter
    SQL = "Select * From [Migration Geotec_1- Côte Nord]"
    Set rs = CurrentDb.OpenRecordset(SQL)
    'a adapter
    Fichier = "D:\_Docs_Prog_Excel\ADODB_excel\fichier_test1.xlsx"
    
    Set cnxl = New ADODB.Connection
    Set Cd = New ADODB.Command
    Set Rsxl = New ADODB.Recordset
    With cnxl
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & Fichier & ";ReadOnly=0;HDR=YES"
        .Open
    End With
    Cd.ActiveConnection = cnxl
    'mettre le nom de le feuille et les colonnes a selectionner
    Cd.CommandText = " SELECT * FROM [fichier_test$A:B]"
    'creation recordset feuille excel
    Rsxl.Open Cd, , adOpenKeyset, adLockOptimistic
    'boucle sur le recordset
    Do While Not Rsxl.EOF
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields(0) = Rsxl(0)        'nom de champ ou numero a adapter
            .Fields(1) = Rsxl(1)        'nom de champ ou numero a adapter
            .Update ' stores the new record
        End With
        Rsxl.MoveNext
    Loop
    
    MsgBox "Ajout termine"
    
    rs.Close
    Set rs = Nothing
    cnxl.Close
    Set cnxl = Nothing
    Set Cd = Nothing
    Set Rsxl = Nothing
End Sub

Sub DataExcel_Access()
    Dim Rsxl As ADODB.Recordset, r As Long
    Dim rs As Recordset
    Dim cnxl As ADODB.Connection
    Dim Cd As ADODB.Command
    
    Set db = CurrentDb
    ' open a recordset: nom de table a adapter
    SQL = "Select * From [EXTRACTED_RECORDS]"
    Set rs = CurrentDb.OpenRecordset(SQL)
    'a adapter
    Fichier = "C:\Users\Desktop\BD\EXTRACT_XLTOACCESS.xlsm"
    
    Set cnxl = New ADODB.Connection
    Set Cd = New ADODB.Command
    Set Rsxl = New ADODB.Recordset
    With cnxl
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & Fichier & ";ReadOnly=0;HDR=YES"
        .Open
    End With
    Cd.ActiveConnection = cnxl
    'mettre le nom de le feuille et les colonnes a selectionner
    Cd.CommandText = " SELECT * FROM [Results$A:L]"
    'creation recordset feuille excel
    Rsxl.Open Cd, , adOpenKeyset, adLockOptimistic
    'boucle sur le recordset
    Do While Not Rsxl.EOF
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields(0) = Rsxl(0)        
            .Fields(1) = Rsxl(1)        
            .Fields(2) = Rsxl(2)        
            .Fields(3) = Rsxl(3)        
            .Fields(4) = Rsxl(4)       
            .Fields(5) = Rsxl(5)        
            .Fields(6) = Rsxl(6)        
            .Fields(7) = Rsxl(7)        
            .Fields(8) = Rsxl(8)        
            .Fields(9) = Rsxl(9)        
            .Fields(10) = Rsxl(10)        
            .Fields(11) = Rsxl(11)        
            .Update ' stores the new record
        End With
        Rsxl.MoveNext
    Loop
    
    MsgBox "Ajout termine"
    
    rs.Close