Discussion :

[kouassi gerard]

Bonjour,

J'ai une liste de contacts stockée dans un fichier Excel. Ce fichier Excel se trouve dans SharePoint. J'ajoute ou supprime régulièrement des contacts (adresse e-mail, nom, etc.) dans ce fichier Excel. C'est pourquoi je souhaite automatiser le processus de mise à jour de mes contacts Outlook en utilisant ce fichier Excel.

J'ai mis en place une solution qui fonctionne lorsque je souhaite stocker ces contacts dans le dossier Outlook par défaut appelé "Contacts". Cependant, je ne souhaite pas les stocker dans ce dossier. J'ai créé un groupe de contacts nommé "groupe1" dans le dossier par défaut, et c'est dans ce groupe que je souhaite stocker les contacts mis à jour. Ainsi, lorsque je souhaite leur envoyer un e-mail, je n'ai qu'à saisir le nom du groupe (groupe1) et récupérer tous les contacts.

Mon véritable problème est le suivant : Lorsque je suis dans le dossier "Contacts", je dois accéder au groupe "groupe1" et modifier les éléments des contacts. Bien que mon script ci-dessous fonctionne sans erreurs, le résultat escompté n'est pas atteint car les contacts du groupe1 ne sont pas modifiés.

J'apprécierais votre aide sur cette question !

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
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
 
Sub ActualiserContactsOutlookDepuisExcelSharePoint()
 
    ' Configuration SharePoint
    Dim sharepointSiteURL As String
    Dim sharepointFilePath As String
    Dim excelFileName As String
    Dim excelSheetName As String
 
    sharepointSiteURL = "https://your-sharepoint-site-url.com"
    sharepointFilePath = "/Shared Documents/Folder/ExcelFile.xlsx"
    excelFileName = "ExcelFile.xlsx"
    excelSheetName = "Sheet1"
 
    ' Configuration Outlook
    Dim objOutlook As Object
    Dim objNamespace As Object
    Dim objContactsFolder As Object
    Dim objContactGroup As Object
    Dim objContact As Object
 
    ' Obtenir une référence à Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
 
    ' Obtenir une référence au dossier des contacts
    Set objContactsFolder = objNamespace.GetDefaultFolder(10)
 
    ' Nom du dossier "Contacts"
    Dim contactsFolderName As String
    contactsFolderName = "Contacts"
 
    ' Nom du groupe de contacts à accéder
    Dim groupName As String
    groupName = "groupe1"
 
    ' Parcourir les dossiers de contacts pour trouver le dossier "Contacts"
    Dim contactsFolder As Object
    For Each contactsFolder In objContactsFolder.Folders
        If contactsFolder.Name = contactsFolderName Then
            ' Parcourir les groupes de contacts dans le dossier "Contacts" pour trouver le groupe spécifié
            For Each objContactGroup In contactsFolder.Folders
                If objContactGroup.Name = groupName Then
                    ' Le groupe de contacts spécifié a été trouvé
 
                    ' Ouvrir le fichier Excel dans SharePoint
                    Dim excelApp As Object
                    Dim excelWorkbook As Object
                    Dim excelWorksheet As Object
                    Dim rngData As Object
                    Dim rngRow As Object
 
                    ' Créer une instance de l'application Excel
                    Set excelApp = CreateObject("Excel.Application")
                    excelApp.Visible = False
 
                    excelApp.Workbooks.Open (sharepointSiteURL & sharepointFilePath)
                    Set excelWorkbook = excelApp.Workbooks(excelFileName)
                    Set excelWorksheet = excelWorkbook.Worksheets(excelSheetName)
 
                    ' Récupérer la plage de données à partir de la feuille Excel
                    Set rngData = excelWorksheet.Range("A2:C" & excelWorksheet.Cells(excelWorksheet.Rows.Count, 1).End(-4162).Row)
 
                    ' Parcourir les lignes de données
                    For Each rngRow In rngData.Rows
                        Dim strEmailAddress As String
 
                        ' Récupérer l'adresse e-mail de la cellule dans la colonne A
                        strEmailAddress = rngRow.Cells(1).Value
 
                        ' Vérifier si l'adresse e-mail est non vide
                        If Not IsEmpty(strEmailAddress) Then
                            ' Rechercher le contact correspondant dans le groupe de contacts
                            Set objContact = objContactGroup.Items.Find("[Email1Address] = '" & strEmailAddress & "'")
 
                            ' Vérifier si le contact a été trouvé
                            If Not objContact Is Nothing Then
                                ' Modifier les propriétés du contact avec les données de la ligne Excel
                                objContact.FirstName = rngRow.Cells(2).Value
                                objContact.LastName = rngRow.Cells(3).Value
                                objContact.Email1Address = strEmailAddress
 
                                ' Enregistrer les modifications
                                objContact.Save
                            End If
                        End If
                    Next rngRow
 
                    ' Fermer le classeur Excel et l'application Excel
                    excelWorkbook.Close SaveChanges:=False
                    excelApp.Quit
 
                    ' Nettoyer les objets Excel
                    Set rngData = Nothing
                    Set rngRow = Nothing
                    Set excelWorksheet = Nothing
                    Set excelWorkbook = Nothing
                    Set excelApp = Nothing
 
                    Exit For
                End If
            Next objContactGroup
 
            Exit For
        End If
    Next contactsFolder
 
    ' Terminer Outlook
    Set objContact = Nothing
    Set objContactGroup = Nothing
    Set objContactsFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
 
    MsgBox "Les contacts dans le groupe de contacts 'KKG-groupe2' ont été mis à jour à partir du fichier Excel SharePoint.", vbInformation
 
End Sub

[Franc]

Salut, je pense que le problème vient du fait que tu as bien déclaré objContactGroup mais à aucun moment dans le code tu ne lui attribues de référence avec la commande Set. Donc la macro ne produit pas d'erreur mais le dossier "groupe1" n'est pas traité. J'ai un peu modifié ta macro en ce sens, j'espère que ce sera la solution à ton problème.

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
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
Sub ActualiserContactsOutlookDepuisExcelSharePoint()
 
    ' Configuration SharePoint
    Dim sharepointSiteURL As String
    Dim sharepointFilePath As String
    Dim excelFileName As String
    Dim excelSheetName As String
 
    sharepointSiteURL = "https://your-sharepoint-site-url.com"
    sharepointFilePath = "/Shared Documents/Folder/ExcelFile.xlsx"
    excelFileName = "ExcelFile.xlsx"
    excelSheetName = "Sheet1"
 
    ' Configuration Outlook
    Dim objOutlook As Object
    Dim objNamespace As Object
    Dim objContactsFolder As Object
    Dim objContactGroup As Object
    Dim objContact As Object
 
    ' Obtenir une référence à Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
 
    ' Obtenir une référence au dossier des contacts
    Set objContactsFolder = objNamespace.GetDefaultFolder(10)
 
    ' Nom du dossier "Contacts"
    Dim contactsFolderName As String
    contactsFolderName = "Contacts"
 
    ' Nom du groupe de contacts à accéder
    Dim groupName As String
    groupName = "groupe1"
 
    ' Parcourir les dossiers de contacts pour trouver le dossier "Contacts"
    Dim contactsFolder As Object
    For Each contactsFolder In objContactsFolder.Folders
        If contactsFolder.DefaultItemType = 10 Then
            If contactsFolder.Name = contactsFolderName Then
                ' Rechercher le groupe de contacts spécifié dans le dossier "Contacts"
                Dim objContactGroup As Object
                Set objContactGroup = contactsFolder.Items.Find("[Name] = 'groupe1'")
 
                If Not objContactGroup Is Nothing Then
                    ' Le groupe de contacts spécifié a été trouvé
 
                    ' Ouvrir le fichier Excel dans SharePoint
                    Dim excelApp As Object
                    Dim excelWorkbook As Object
                    Dim excelWorksheet As Object
                    Dim rngData As Object
                    Dim rngRow As Object
 
                    ' Créer une instance de l'application Excel
                    Set excelApp = CreateObject("Excel.Application")
                    excelApp.Visible = False
 
                    excelApp.Workbooks.Open (sharepointSiteURL & sharepointFilePath)
                    Set excelWorkbook = excelApp.Workbooks(excelFileName)
                    Set excelWorksheet = excelWorkbook.Worksheets(excelSheetName)
 
                    ' Récupérer la plage de données à partir de la feuille Excel
                    Set rngData = excelWorksheet.Range("A2:C" & excelWorksheet.Cells(excelWorksheet.Rows.Count, 1).End(-4162).Row)
 
                    ' Parcourir les lignes de données
                    For Each rngRow In rngData.Rows
                        Dim strEmailAddress As String
 
                        ' Récupérer l'adresse e-mail de la cellule dans la colonne A
                        strEmailAddress = rngRow.Cells(1).Value
 
                        ' Vérifier si l'adresse e-mail est non vide
                        If Not IsEmpty(strEmailAddress) Then
                            ' Rechercher le contact correspondant dans le groupe de contacts
                            Set objContact = objContactGroup.Items.Find("[Email1Address] = '" & strEmailAddress & "'")
 
                            ' Vérifier si le contact a été trouvé
                            If Not objContact Is Nothing Then
                                ' Modifier les propriétés du contact avec les données de la ligne Excel
                                objContact.FirstName = rngRow.Cells(2).Value
                                objContact.LastName = rngRow.Cells(3).Value
                                objContact.Email1Address = strEmailAddress
 
                                ' Enregistrer les modifications
                                objContact.Save
                            End If
                        End If
                    Next rngRow
 
                    ' Fermer le classeur Excel et l'application Excel
                    excelWorkbook.Close SaveChanges:=False
                    excelApp.Quit
 
                    ' Nettoyer les objets Excel
                    Set rngData = Nothing
                    Set rngRow = Nothing
                    Set excelWorksheet = Nothing
                    Set excelWorkbook = Nothing
                    Set excelApp = Nothing
 
                    Exit For
                End If
            End If
        End If
    Next contactsFolder
 
    ' Terminer Outlook
    Set objContact = Nothing
    Set objContactGroup = Nothing
    Set objContactsFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
 
    MsgBox "Les contacts dans le groupe de contacts 'groupe1' ont été mis à jour à partir du fichier Excel SharePoint.", vbInformation
 
End Sub