Discussion :

[Venentius]

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:

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

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.

Pouvez-vous me conseiller? Merci d'avance!
Venentius

[Venentius]

Je vois que mon post n'est pas vraiment au bon endroit: est-ce qu'un admin peut le déplacer dans la partie VBA Access du forum? Merci d'avance. Venentius.