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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
'Fonction à lancer pour test
'Mettre le curseur dans cette fontion puis appuyer sur 'F5' pour démarrer l'importation
'Modifier si besoin ici le nom, le chemin du fichier excel, le nom de la feuille excel et le nom
'de la table Access qui va récupérer les données
Public Function TestImport()
'On veut importer le fichier excel 'FichierExcel_J.xls' qui se trouve dans le même
'répertoire que la base Access.
'La feuille Excel à importer se nomme 'Feuil1'
'La table Access qui va récupérer les données Excel se nomme 'tImportExcel'
'Changer ici le nom de la table pour s'adapter à votre cas
If ImportFromExcel(CurrentProject.Path & "\" & "FichierExcel_J.xls", "Feuil1", "tImportExcel") Then
'Si import ok, on affiche un message
MsgBox "import terminé avec succès !", vbInformation
End If
End Function
'Fonction dérivée d'un code de la FAQ (Cafeine)
'Arguments :
' - Chemin complet + nom du fichier Excel source
' - Nom de la feuille Excel contenant les données à importer
' - Nom de la table Access qui va recevoir les données importées
'Modifier si besoin dans cette fonction le nom des champs de la table Access
Public Function ImportFromExcel(ByVal sFullPathExcelFile As String, _
ByVal sNomFeuille As String, _
ByVal sDestTable As String) As Boolean
'Si une erreur ce produit aller à l'étiquette errtag en fin de fonction
On Error GoTo errtag
'Déclaration des bases de données et des recordsets
Dim oDbXls As DAO.Database, oDb As DAO.Database
Dim oRsXls As DAO.Recordset, oRs As DAO.Recordset
'avRows va recevoir les données issues d'Excel sous forme d'un tableau
Dim avRows As Variant
Dim l As Long, lRows As Long
'Ouverture du fichier Excel comme source de données
Set oDbXls = DBEngine(0).OpenDatabase(sFullPathExcelFile, False, False, "Excel 8.0;")
'Ouverture du recordset 'instantané' des données contenues dans la feuille Excel passée en argument
'Le nom de la feuille Excel doit se terminer par le signe $
Set oRsXls = oDbXls.OpenRecordset(sNomFeuille & "$", dbOpenSnapshot)
'Avec le recordset défini (de la feuille X du fichier Excel Y)
With oRsXls
If Not .EOF Then 'S'il existe des enregistrements
.MoveLast 'Pour initialiser la prorpiété RecordCount utilisée plus loin
.MoveFirst 'Retour au premier enregistrement
lRows = .RecordCount 'Retourne le nombre d'enregistrements ou lignes du fichier
'On récupère toutes les lignes dans un tableau de variants
'Méthode très performante en terme de rapidité
'Tableau à 2 dimensions :
' - La première définie la colonne (de 0 à Nb colonnes - 1)
' - La deuxième définie la ligne (de 0 à Nb lignes - 1)
'Exemple : On veut obtenir la colonne 'NOMCLIENT' de la ligne 5
' - 'NOMCLIENT' est la colonne 2 mais la base du tableau est zéro
' - La ligne 5 correspond à la ligne 4 en base 0 du tableau
' => avRows(1,4) contient le résultat de 'NOMCLIENT' de la ligne 5
avRows = .GetRows(lRows)
End If
.Close 'On ferme le recordset Excel car on détient les données dans avRows
End With
oDbXls.Close 'On ferme la base de données Excel
'Si on a importé des lignes
If lRows > 0 Then
'On ouvre la base de données Access courante
Set oDb = CurrentDb
'On ouvre un recordset type 'table' sur le nom de la table passée en argument
Set oRs = oDb.OpenRecordset(sDestTable, dbOpenTable)
'On ouvre l'index de la colonne 'CODECLIENT' (index sans doublon)
oRs.Index = "CODECLIENT"
'Si code client était la clef primaire, on ouvrirait l'index 'PrimaryKey'
'Avec le recordset
With oRs
'On parcours chaque ligne du tableau (base zéro !) donc lrows - 1
For l = 0 To lRows - 1
'Grâve à l'index on recherche dans la table Access le code client courant
'Dans la feuille Excel, le code client est la première colonne => 0 dans avRows
'L'enregistrement courant correspond à la valeur de l
.Seek "=", avRows(0, l)
'Si le code client n'est pas trouvé on créé un nouvel enregistrement dans la table
If .NoMatch Then
.AddNew
'On affecte à la colonne 'CODECLIENT' de la table la valeur issue du fichier Excel
.Fields("CODECLIENT") = avRows(0, l)
'Si le code client existe, on passe en édition (update) de l'enregistrement trouvé
Else
.Edit
End If
'On édite ou on renseigne les autres colonnes de la table Access
'Adapter le nom des colonnes à ceux de votre table access
.Fields("NOMCLIENT") = avRows(1, l) '= colonne 2 Excel : 'NOMCLIENT'
.Fields("MONTANT") = avRows(2, l) '= colonne 3 Excel : 'MONTANT'
.Fields("TRANSDATE") = avRows(3, l) '= colonne 4 Excel : 'DATE'
'On enreigstre la création ou la modification de l'enregistrement
.Update
Next l
.Close 'On ferme le recordset de la table Access
End With
oDb.Close 'On ferme la base de données Access
End If
ImportFromExcel = True 'Si on arrive ici, c'est que tout est ok, pas d'erreur
'Etiquette de fin
fin:
'On libère les classes en commençant par le recordset puis la bases de données
Set oRsXls = Nothing
Set oDbXls = Nothing
Set oRs = Nothing
Set oDb = Nothing
Exit Function 'Force la fin de la fonction pour ne pas évaluer les lignes suivantes
'Etiquette du gestionnaire d'erreur, on arrive ici que si une erreur se produit
errtag:
'Affiche le message de l'erreur levée
MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description :" & Err.Description, vbExclamation, "Erreur..."
'Nettoie l'erreur et saut sur l'étiquette fin pour libérer les classes : important !
Resume fin
End Function |
Besoin d'astuces pour implémenter un choix entre un UPDATE et un INSERT TO
Répondre avec citation
:
.
Partager