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
| Option Compare Database
Option Explicit
Private Sub parcourir_Click()
Me.chemin_d_importation = OuvrirUnFichier(Me.Hwnd, "Données à importer", 1)
End Sub
Sub ADOFromExcelToAccess()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Dim db As Database
Dim rs_stokage As Recordset
DoCmd.TransferSpreadsheet acImport, 10, "STOCKAGE_IMPORTS", Forms!menu_importation!chemin_d_importation, True, ""
Set db = CurrentDb
Set rs_stokage = db.OpenRecordset("STOCKAGE_IMPORTS") ' STOCKAGE_IMPORTS est une table access existante et vide ou je souhaite stocker mes donner au fur et à mesure que je vais chercher les données de excel
' ici le code que j'ai trouvé sert à aller chercher les données du fichier avant transfert ( si c'est bien cela ??????? )
' exports data from the active worksheet to a table in an Access database this procedure must be edited before use
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & "Data Source=Forms!menu_importation!chemin_d_importation;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "STOCKAGE_IMPORTS", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 20 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
' c'est toutes les colonnes présentent le fichier excel
.Fields("LIB_NOM_PAT_IND") = Range("A" & r).Value
.Fields("LIB_PR1_IND") = Range("B" & r).Value '
.Fields("LIB_AD2") = Range("C" & r).Value
.Fields("COD_COM") = Range("D" & r).Value
.Fields("LIB_COM") = Range("E" & r).Value
.Fields("COD_DEP") = Range("F" & r).Value
.Fields("NUM_TEL") = Range("G" & r).Value
.Fields("NUM_TEL_PORT") = Range("H" & r).Value
.Fields("ADR_MAIL") = Range("I" & r).Value
.Fields("COD_BAC") = Range("J" & r).Value
.Fields("LIB_ETB") = Range("K" & r).Value
.Fields("LIB_AD1_ETB") = Range("L" & r).Value
.Fields("LIB_AD2_ETB") = Range("M" & r).Value
.Fields("COD_COM_ADR_ETB") = Range("N" & r).Value
.Fields("VILLE") = Range("O" & r).Value
.Fields("Facebook") = Range("P" & r).Value
.Fields("Viadeo") = Range("Q" & r).Value
.Fields("COD_IND") = Range("R" & r).Value
.Fields("COD_NNE_IND") = Range("S" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
' ce code VBA marche en partie la boite de dialogue pour chercher le fichier s'ouvre et le nom du fichier et bien référencé dans la barre texte , par contre j'ignore si il y a des erreurs ou des manques vu que je connais pas la programmation système VBA :oops: |
Partager