Actualiser des données importées dans Access par formulaire Excel

**Venentius** · 06/11/2015, 17h31

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 (colonne 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

Je reçois maintenant des formulaires de nouveaux contacts mais aussi des formulaires visant l'actualisation des données (numéro de téléphone ou adresse p. ex.). Le problème est que dans le même formulaire, je peux avoir des nouvelles personnes et des actualisations. Durant le processus d'importation, il faudrait donc que je puisse effectuer une action distincte en fonction de la présence ou non d'un contact déjà existant dans le base de données.

Je me permets de vous solliciter pour une piste afin de démarrer correctement.

Merci d'avance! Venentius

**Mat.M** · 07/11/2015, 11h33

bonjour pour actualiser la base access..il suffit d'avoir la logique inverse.
C'est à dire que si le fichier Excel a changé il faut ouvrir une connection de la base Access donc créer des recordsets et les mettre à jour, sous Excel.
Avec les mécanismes d'Office cela doit se faire facilement.
Par code VBA il existe certainement une méthode pour détecter si une feuille courante d'Excel a été modifiée et enregistrée.
Donc je me répète , ouvrir une connection sur la base de données, balayer la feuille Access.

Ou encore mieux on peut lier une base Access sous une feuille Excel.
Si la feuille Excel est modifiée , Office peut mettre automatiquement à jour la base Access.
Donc il n'y a pas forcément besoin de faire de code VBA pour ça.

Dans Excel, onglet Données >depuis Acess puis sélectionner la table désirée.

modification de mon message à 11:39 : bon ça ne marche pas sous Excel apparemment les modifications des données ne sont pas répercutées dans Access donc oui il faut faire du code VBA sous Excel et mettre à jour la base Access

**Robert1957** · 08/11/2015, 17h43

Bonjour Venentius,

Ce n'est pas tellement compliqué de mettre à jour, cependant le problème est comment identifier ce que tu as déjà dans ta table de contact. Quel champ du fichier Excel peut-être considéré comme clé primaire?

Cela dit à partir de ce champ tu peux rechercher l'enregistrement dans la table contact. Si l'enregistrement existe tu le mets à jour sinon tu le crées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
rst.FindFirst 'Le critère clé primaire
If rst.NoMatch then
   rst.AddNew
   'la routine
   rst.Update
Else
   rst.Edit
   'la routine
   rst.Update
End if

Bonne journée

**Venentius** · 09/11/2015, 12h45

Bonjour Mat.M et Robert,

Je vous remercie de vos réponses.

J'ai suivi l'input de Robert. Mon souci est que je n'ai pas vraiment de clé primaire dans le fichier Excel. Du coup, je me rabats sur le courriel comme clé relativement fiable. Ce qui me donne le code suivant:

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
 
Public Function fuExcel()
 
    Dim oApp As Excel.Application
    Dim oWkb As Excel.Workbook
    Dim oWSht As Excel.Worksheet
    Dim i As Long
    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)
 
        rs.FindFirst "Mail = " & oWSht.Range("H" & i).Value
        If rs.NoMatch Then
            With rs
                .AddNew
                .Fields("CatService") = oWSht.Range("A" & i).Value
                .Fields("Service") = oWSht.Range("B" & i).Value
                .Fields("District") = oWSht.Range("C" & i).Value
                .Fields("Titre") = oWSht.Range("D" & i).Value
                .Fields("Nom") = oWSht.Range("E" & i).Value
                .Fields("Prenom") = oWSht.Range("F" & i).Value
                .Fields("Fonction") = oWSht.Range("G" & i).Value
                .Fields("Mail") = oWSht.Range("H" & i).Value
                .Fields("TelDirect") = oWSht.Range("I" & i).Value
                .Fields("TelSecretariat") = oWSht.Range("J" & i).Value
                .Fields("Fax") = oWSht.Range("K" & i).Value
                .Fields("Rue") = oWSht.Range("L" & i).Value
                .Fields("NumRue") = oWSht.Range("M" & i).Value
                .Fields("CP") = oWSht.Range("N" & i).Value
                .Fields("NPA") = oWSht.Range("O" & i).Value
                .Fields("Ville") = oWSht.Range("P" & i).Value
                .Fields("DateImport") = Now
                .Update
            End With
        Else
            With rs
                .Edit
                .Fields("CatService") = oWSht.Range("A" & i).Value
                .Fields("Service") = oWSht.Range("B" & i).Value
                .Fields("District") = oWSht.Range("C" & i).Value
                .Fields("Titre") = oWSht.Range("D" & i).Value
                .Fields("Nom") = oWSht.Range("E" & i).Value
                .Fields("Prenom") = oWSht.Range("F" & i).Value
                .Fields("Fonction") = oWSht.Range("G" & i).Value
                .Fields("Mail") = oWSht.Range("H" & i).Value
                .Fields("TelDirect") = oWSht.Range("I" & i).Value
                .Fields("TelSecretariat") = oWSht.Range("J" & i).Value
                .Fields("Fax") = oWSht.Range("K" & i).Value
                .Fields("Rue") = oWSht.Range("L" & i).Value
                .Fields("NumRue") = oWSht.Range("M" & i).Value
                .Fields("CP") = oWSht.Range("N" & i).Value
                .Fields("NPA") = oWSht.Range("O" & i).Value
                .Fields("Ville") = oWSht.Range("P" & i).Value
                .Fields("DateImport") = Now
                .Update
            End With
        End If
    rs.Close
    Set rs = Nothing
 
     i = i + 1
    Wend
    'On ferme
    oWkb.Close
    oApp.Quit
    'On libère les objets
    i = 0
    Set oWSht = Nothing
    Set oWkb = Nothing
    Set oApp = Nothing
    MsgBox "Opération terminée."
 
End Function

Mon problème se situe sur le critère... l'erreur vient sans doute de ma syntaxe. Je n'ai pas trouvé sur internet de solutions. Puis-je vous demander encore un peu d'aide? Merci d'avance! Venentius

**Robert1957** · 09/11/2015, 13h18

Bonjour Venentius,

Probablement parce que c'est du texte donc:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rs.FindFirst ("[Mail] = " & chr(34) & oWSht.Range("H" & i).Value & chr(34) )

Chr(34) est la constante pour "

De plus tu n'as pas besoin d'éditer le mail dans la deuxième partie de ton code (ligne 64).

Bonne journée

**Venentius** · 12/11/2015, 16h10

Cher Robert,

je te remercie de ton précieux conseil, tout fonctionne à merveille.

Avec mes meilleures salutations, Venentius

Actualiser des données importées dans Access par formulaire Excel [AC-2010]

VBA Access

Discussions similaires

Partager

Partager