Import de donnée excel dans access
Bonjour,
je voudrais inserer dans une table access toutes les données d'une FEUILLE excel à partir d'une certaines lignes et pour x colonnes (correspondant aux champs dans access).
Merci d'avance.
Résolu.
J'ai trouvé un bout de code qui envoyer les données à partir d'excel vers access. J'y ai fait un peu le ménage et adapté à mon problème, lancement à partir d'access
Voici ci-dessous le code :
Code:
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
|
Sub WritingWorksheetData_DAO(tablename As String, filename As String, Path As String)
Dim Plage As Range
Dim Array1 As Variant
Dim x As Variant
Dim oDb As Database
Dim oRst As Recordset
Set oDb = CurrentDb
Dim SQL As String
SQL = "Delete * From " & tablename & " where filename = '" & filename & "'"
DoCmd.RunSQL SQL
Set oRst = oDb.OpenRecordset(tablename, dbOpenDynaset)
'Déclaration des variables
Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel
'Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
'Ouverture d'un fichier Excel
Set wbExcel = appExcel.Workbooks.Open(Path & "\" & filename)
'wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)
'Récupération de la feuille s'appellant maFeuille
Set sheet = appExcel.ActiveWorkbook.Sheets("Test")
Set Plage = sheet.Range("A2").CurrentRegion.Offset(1, 0)
Set Plage = Plage.Resize(Plage.Rows.Count - 1, Plage.Columns.Count)
Plage.Select
' Lecture de la plage pour renvoyer une valeur contenant un tableau
Array1 = Plage.Value
' Ecriture des données depuis Excel vers les enregistrement de la table
For x = 1 To UBound(Array1, 1)
With oRst
.AddNew
Debug.Print filename
.Fields("filename") = filename
.Fields("test1") = Trim$(Array1(x, 1))
Debug.Print Array1(x, 2)
.Fields("test2") = Trim$(Array1(x, 2))
.Update
End With
Next
oRst.Close
oDb.Close
' Effacement des données copiées vers la base (sauf les titres)
With Selection.CurrentRegion
Intersect(.Cells, .Offset(1)).Select
End With
Selection.ClearContents
wbExcel.Close SaveChanges:=False
End Sub |