Bonjour,
Grâce à l'aide de Robert1957, j'ai récemment élaboré une base de données de contact qui peut être alimentée par l'importation d'un fichier Excel au moyen de la fonction ci-dessous:
Mon souci est que je ne peux pas intégrer deux fichiers Excel différents de suite. Access me renvoie un Run Time Error 1004 ou, suivant le nombre de lignes à importer dans le 2ème fichier Excel, Access réimporte une partie des données du 1er fichier Excel. C'est comme si les objets concernés n'étaient pas vidés.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Option Compare Database Option Explicit Public Function fuExcel() Dim oApp As Excel.Application Dim oWkb As Excel.Workbook Dim oWSht As Excel.Worksheet Dim i As Integer Dim strFeuille As String, strChemin As String strFeuille = "Saisie" 'Inscrire le nom de la feuille du classeur strChemin = "" strChemin = fuCheminFichier() 'Récupère la réponse If strChemin = "" Then 'Si l'utilisateur à cliquer sur le bouton cancel, sortie de la fonction MsgBox "Aucun fichier sélectionné, abandon de l'opération." Exit Function End If Set oApp = CreateObject("excel.application") Set oWkb = oApp.Workbooks.Open(strChemin) Set oWSht = oWkb.Worksheets(strFeuille) i = 2 'Première ligne à parcourir, on ici débute à la ligne #2 'On parcours le fichier Excel tant qu'il y a de l'information dans la colonne nom (colone E) 'Ici la colonne qu'on veut tester While oWSht.Range("E" & i).Value <> "" 'On récupère la valeur des différentes colonnes ici celle qui a le nom dans le fichier Excel 'Enregistrement des données avec un RecordSet Dim rs As Recordset Set rs = CurrentDb.OpenRecordset("T_Contacts", dbOpenDynaset) With rs .AddNew .Fields("CatService") = Range("A" & i).Value .Fields("Service") = Range("B" & i).Value .Fields("District") = Range("C" & i).Value .Fields("Nom") = Range("E" & i).Value .Fields("Titre") = Range("D" & i).Value .Fields("Prenom") = Range("F" & i).Value .Fields("Fonction") = Range("G" & i).Value .Fields("Mail") = Range("H" & i).Value .Fields("TelDirect") = Range("I" & i).Value .Fields("TelSecretariat") = Range("J" & i).Value .Fields("Fax") = Range("K" & i).Value .Fields("Rue") = Range("L" & i).Value .Fields("NumRue") = Range("M" & i).Value .Fields("CP") = Range("N" & i).Value .Fields("NPA") = Range("O" & i).Value .Fields("Ville") = Range("P" & i).Value .Fields("DateImport") = Now .Update End With rs.Close Set rs = Nothing i = i + 1 Wend 'On ferme oWkb.Close 'On libère les objets Set oWSht = Nothing Set oWkb = Nothing Set oApp = Nothing MsgBox "Opération terminée." End Function Private Function fuCheminFichier() Dim fDialog As Office.FileDialog Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .AllowMultiSelect = False .Title = "Veuillez sélectioner le fichier Excel à importer." .Filters.Clear .Filters.Add "Classeur Excel", "*.xls" .Filters.Add "Classeur Excel", "*.xlsx" .Filters.Add "Tous fichiers", "*.*" If .Show = True Then fuCheminFichier = .SelectedItems(1) Else fuCheminFichier = "" End If End With Set fDialog = Nothing End Function Sub insExcel() Call fuExcel End Sub
Pouvez-vous me conseiller? Merci d'avance!
Venentius
Partager