Rdv vers outlook sur calendrier partagé

[MikaTI]

Bonjour à tous,

J'utilise un fichier pour de la prospection qui permet d'envoyer des dates vers Outlook.
Ce fichier est bien fonctionnel, sauf maintenant, j'aimerai pouvoir envoyer ces dates vers un calendrier qui est partagé.
Je m'explique :
Aujourd'hui, ces dates sont envoyées dans un calendrier "PROSPECTION" créé dans le groupe Mes Calendrier.
Je souhaiterai changer en envoyant ces dates dans un calendrier toujours appelé "PROSPECTION" mais qui est dans le groupe CALENDRIERS PARTAGES....

Pour cela, j'ai supprimé mon calendrier actuel "PROSPECTION", et j'ai ouvert le nouveau calendrier Prospection qu'une personne a partagé avec moi... Bien evidemment, j'ai un erreur quand j'exécute la macro.

Je n'arrive pas à trouver quel remplacement faire dans mon code, malgré des recherches faites sur internet etc...

Si quelqu'un aurait une idée.......

Merci 🙂

Voici le code

Sub ajout()

    Dim DateDebut As String
    Dim Nom As String
    Dim journee As String
    Dim sSearch As String
    Dim OutlApp As New Outlook.Application
    Dim OutlItems As Outlook.Items
    Dim OutlAppointment As Outlook.AppointmentItem
    Dim MyCalendar As Outlook.Items
    Dim OutlMapi As Outlook.Namespace
    Dim OutlFolder As Outlook.MAPIFolder
    Dim MyItem As Outlook.AppointmentItem
    Dim Cell As Range
    Dim cal As String

    'plage de donnée
   For Each Cell In Range("A4:A" & Range("A6000").End(xlUp).Row)
        'fin de plage de donnée

        'Pour la vérification des doublons on utilise les données suivantes :
       If Cell <> "" Then    'recherche dans la plage si il existe des données à inscrire

            If Cell.Offset(0, 14) <> "" Then
                DateDebut = Cell.Offset(0, 14) & " " & Cell.Offset(0, 15)    'date
               Nom = "Relance" & " " & Cell.Offset(0, 0) & " - " & Cell.Offset(0, 1)    'nom
               journee = Cell.Offset(0, 6)    ' Toute la journée oui/non
               'Fin des données pour la valitation de doublon

                'Crée la sélection du calendrier dans Outlook
               Set OutlApp = CreateObject("Outlook.Application")
                Set OutlMapi = OutlApp.GetNamespace("MAPI")
                Set OutlFolder = OutlMapi.GetDefaultFolder(olFolderCalendar)
                Set OutlItems = OutlFolder.Folders("prospection").Items    ' Nom du calendrier - Attention calendrier ajouté en dessous du calendrier par default et nom dans un nouveau groupe.
               'Set OutlItems = OutlFolder.Items ' Calendrier par default

                'Vérification de doublon pour les rdv
               On Error Resume Next
                sSearch = "[AllDayEvent] = '" & journee & "' and [Start] = '" & DateDebut & "' and  [Subject] = '" & Nom & "'"
                Set OutlAppointment = OutlItems.Find(sSearch)
                On Error GoTo 0
                'fin vérification doublon


                If OutlAppointment Is Nothing Then    's'il n'y a pas de doublons lancement du code
                   'On choisi le calendrier
                   Set MyCalendar = OutlItems    'choix calendrier
                   'Fin choix calendrier


                    Set MyItem = MyCalendar.Add(olAppointmentItem)

                    With MyItem    'inscription des données dans excel
                       .MeetingStatus = olNonMeeting    'meeting
                       .Subject = "Relance" & " " & Cell.Offset(0, 0) & " - " & Cell.Offset(0, 1)    'Sujet
                       .Start = Cell.Offset(0, 14) & " " & Cell.Offset(0, 15)    ' Date plus heure. Heure toujours mettre cellude vide
                       .Duration = 30    'durée du RDV en minute"
                       .Location = Cell.Offset(0, 4) & " - " & Cell.Offset(0, 5)    'emplacement
                       .AllDayEvent = True    ' Ou remplacer par cell.offset si a déterminer dans cellule
                       .ReminderSet = True    ' Ou remplacer par cell.offset si à déterminer dans cellule
                       .ReminderMinutesBeforeStart = 1    ' Durée du rappel en minute
                       .body = Cell.Offset(0, 13)    'Pour les commentaires ou sujets
                       .Categories = "PROSPECTION" 'S'assurer que la catégorie "" est bien créé dans le calendrier avec couleur au choix
                        .Save

                    End With
                    Set MyItem = Nothing
                End If
            End If
        End If
    Next Cell    'tant que les cellules de la plage est complete on relance le macro

End Sub

 

[Lone-wolf]

Re : Rdv vers outlook sur calendrier partagé

Bonjour MikaTI

Si tu parle de l'onglet "Groupe de contacts", il faut qu'ils soient déjà enregistrés. Je viens de regarder en cliquant sur le calendrier dans le groupe.



A+ 😎

 

[MikaTI]

Re : Rdv vers outlook sur calendrier partagé

Bonjour MikaTI

Si tu parle de l'onglet "Groupe de contacts", il faut qu'ils soient déjà enregistrés. Je viens de regarder en cliquant sur le calendrier dans le groupe.



A+ 😎

Bonjour

Désolé je ne suis pas sur de comprendre ta réponse...
Voici une capture en pièces jointes... (le calendrier partagé sur lequel je voudrai que les rendez vous s'enregistrent est dans le groupe "Calendriers PARTAGES)

 

[Lone-wolf]

Re : Rdv vers outlook sur calendrier partagé

Re,

le dossier "Mes Calendriers" c'est toi qui l'a créé manuellement ou avec la macro?


A+ 😎

 

[Lone-wolf]

Re : Rdv vers outlook sur calendrier partagé

Re,

est-ce que ceci pourrait t'aider?

'Il s'agit de la traduction d'une macro développée par SUE MOSHER.

Sub ProcessFolder(StartFolder As Outlook.MAPIFolder)
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem as Object
    On Error Resume Next
   
    ' Ici on fait quelque chose dans chaque dossier
   ' on écrit une ligne dans la fenêtre exécution
    Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
    Debug.Print
       
    ' Parcourt tous les sous-dossiers de ce dossier 
    For Each objFolder In StartFolder.Folders
        Call ProcessFolder(objFolder)
    Next
   
    ' Parcourt tous les éléments de ce dossier. 
    For Each objItem In StartFolder.Items
        Call ProcessItem(objItem)
    Next
   
    Set objFolder = Nothing
End Sub

Exemple d'utilisation à la racine de la BOÎTE .

Sub ListSubFolders()
    
    Dim OL As Outlook.Application
    Dim OLNS As Outlook.NameSpace
    Dim OLItem As Object
    Dim OLFolder As Outlook.Folders
   
    Set OL = New Outlook.Application
    Set OLNS = OL.GetNamespace("MAPI")
   
    Set OLFolder = OLNS.GetDefaultFolder(olFolderInbox).Folders
'Ici on exécute la macro en question
    ProcessFolder OLNS.GetDefaultFolder(olFolderInbox).Parent
End Sub

A+ 😎

 

[MikaTI]

Re : Rdv vers outlook sur calendrier partagé

Re,

le dossier "Mes Calendriers" c'est toi qui l'a créé manuellement ou avec la macro?


A+ 😎

Bonjour

le dossier "Mes Calendriers" est le dossier par défaut d'outlook... Donc non je ne l'ai pas créé manuellement...

 

[MikaTI]

Re : Rdv vers outlook sur calendrier partagé

Re,

est-ce que ceci pourrait t'aider?

'Il s'agit de la traduction d'une macro développée par SUE MOSHER.

Sub ProcessFolder(StartFolder As Outlook.MAPIFolder)
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem as Object
    On Error Resume Next
   
    ' Ici on fait quelque chose dans chaque dossier
   ' on écrit une ligne dans la fenêtre exécution
    Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
    Debug.Print
       
    ' Parcourt tous les sous-dossiers de ce dossier 
    For Each objFolder In StartFolder.Folders
        Call ProcessFolder(objFolder)
    Next
   
    ' Parcourt tous les éléments de ce dossier. 
    For Each objItem In StartFolder.Items
        Call ProcessItem(objItem)
    Next
   
    Set objFolder = Nothing
End Sub

Exemple d'utilisation à la racine de la BOÎTE .

Sub ListSubFolders()
    
    Dim OL As Outlook.Application
    Dim OLNS As Outlook.NameSpace
    Dim OLItem As Object
    Dim OLFolder As Outlook.Folders
   
    Set OL = New Outlook.Application
    Set OLNS = OL.GetNamespace("MAPI")
   
    Set OLFolder = OLNS.GetDefaultFolder(olFolderInbox).Folders
'Ici on exécute la macro en question
    ProcessFolder OLNS.GetDefaultFolder(olFolderInbox).Parent
End Sub

A+ 😎

Je dois avouer qu'étant débutant en vba, je ne sais pas comment mettre ce code dans mon code initial :s

Une petite idée? 🙂