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
| Sub ImporterCmdes()
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim i As Long, strTrc As String
Dim db As DAO.Database, rsDest As DAO.Recordset
Dim fDlg As Office.FileDialog, strFichier As String
On Error GoTo ErrH:
' --------------------------
' Selection du fichier Excel
' --------------------------
Set fDlg = Application.FileDialog(msoFileDialogOpen)
' Définition du ou des filtres
fDlg.Filters.Clear
fDlg.Filters.Add "Fichier Excel", "*.xl*"
' Dossier de départ
fDlg.InitialFileName = CurrentProject.Path
' Type d'affichage
fDlg.InitialView = msoFileDialogViewList
If fDlg.Show Then
strFichier = fDlg.SelectedItems(1)
End If
Set fDlg = Nothing
' Si l'utilisateur a cliqué sur Annuler quitter la procédure
If Len(strFichier) = 0 Then Exit Sub
' --------------------------
' Ouverture du fichier Excel
' --------------------------
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(strFichier) 'Fichier sélectionné par l'utilisateur
Set oWSht = oWkb.Worksheets("Feuil1") 'mettez ici le nom de la feuille qui contient les données à importer
' On ouvre un recordset sur la table dans laquelle on veut
' ajouter des enregistrements
Set db = CurrentDb
Set rsDest = db.OpenRecordset("tblCmdes", dbOpenDynaset)
'première ligne ou commence l'import
i = 11
'Tant que la colonne 1 (A) n'est pas vide
While Len(oWSht.Cells(i, 1).Text) > 0
'condition de remplissage de la table => eviter les doublons
'si l'enregistrement existe déjà dans la table destination,
'on passe à la ligne suivante sans l'importer
If DCount("*", "[tblCmdes]", "[NumCmde] = " & oWSht.Cells(i, 1)) = 0 Then
'le numéro 1 correspond au numéro de la colonne source, tel que : A=1, B=2, C=3 ...
rsDest.AddNew
strTrc = "Champ [NumCmde]"
rsDest("NumCmde") = oWSht.Cells(i, 1)
strTrc = "Champ [CodeClient]"
rsDest("CodeClient") = oWSht.Cells(i, 2)
strTrc = "Champ [NumEmploye]"
rsDest("NumEmploye") = oWSht.Cells(i, 3)
strTrc = "Champ [DateCmde]"
rsDest("DateCmde") = oWSht.Cells(i, 4)
strTrc = "Champ [À livrer avant]"
rsDest("À livrer avant") = oWSht.Cells(i, 5)
strTrc = "Champ [DateEnvoi]"
rsDest("DateEnvoi") = oWSht.Cells(i, 6)
strTrc = "Champ [NumMessager]"
rsDest("NumMessager") = oWSht.Cells(i, 7)
strTrc = "Champ [NumCmPortde]"
rsDest("Port") = oWSht.Cells(i, 8)
strTrc = "Sauver Nouvel Enregistrement"
rsDest.Update
End If
strTrc = ""
'on incrémente la variable i pour passer à la ligne suivante
i = i + 1
Wend
Sortie:
Set oWSht = Nothing
If Not (oWkb Is Nothing) Then oWkb.Close False
Set oWkb = Nothing
If Not (oApp Is Nothing) Then oApp.Quit
Set oApp = Nothing
If Not (rsDest Is Nothing) Then rsDest.Close
Exit Sub
ErrH:
Select Case Err.Number
Case 3022 ' Risque de doublon - Violation Clé/Index unique
' on annule l'ajout et on continue
rsDest.CancelUpdate
Resume Next
' Erreur ignorées. Pour les prendre en compte, mettre en commentaire
' l'instruction Resume Next
Case 3163 ' Le champ est trop petit pour accepter la quantité de données que vous voulez ajouter
Resume Next
Case 3349 ' Dépassement de capacité sur un champ numérique
Resume Next
Case 3421 ' Erreur de conversion de type
Resume Next
End Select
MsgBox "Erreur No. " & Err.Number & " : " & Err.Description, , _
"Ligne " & i & ". " & strTrc
Resume Sortie
End Sub |
Adapter un code "import de de fichier excel dans table access" avec possibilité d'aller chercher le fichier.
Répondre avec citation
Je n'ai rien contre les Mac's ni contre Linux.
Envoyé par Chagui
Partager