Rdv vers outlook sur calendrier partagé

M

MikaTI

XLDnaute Junior
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
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
 
Trier par date Trier par votes
M

MikaTI

XLDnaute Junior
Re : Rdv vers outlook sur calendrier partagé

Lone-wolf à dit:
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+ :cool:
Cliquez pour agrandir...

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)
 

Pièces jointes

  • Sans titre.png
    Sans titre.png
    2.2 KB · Affichages: 41
  • Sans titre.png
    Sans titre.png
    2.2 KB · Affichages: 39
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Rdv vers outlook sur calendrier partagé

Re,

est-ce que ceci pourrait t'aider?

Code: 
'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+ :cool:
 
Vote positif 0 Vote négatif
M

MikaTI

XLDnaute Junior
Re : Rdv vers outlook sur calendrier partagé

Lone-wolf à dit:
Re,

est-ce que ceci pourrait t'aider?

Code: 
'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+ :cool:
Cliquez pour agrandir...

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? :)
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
XL 2016 Ajouter planning Outlook un rdv(sans activer de reference "Microsoft Outlook object library xx.x"
Réponses
2
Affichages
260
fredl
F
Fred_Garnier
  • Question
XL 2010 VBA Outlook Excel_plusieurs RV dans un même calendrier
Réponses
0
Affichages
897
Fred_Garnier
Fred_Garnier
E
  • Question
XL 2013 Ajouter un rdv calendrier depuis excel via exchange
Réponses
0
Affichages
807
estivill
E
C
  • Question
XL 2019 Atteindre depuis excel plusieurs calendriers partagé outlook de destination
Réponses
2
Affichages
715
chich
C
B
  • Résolu(e)
Microsoft 365 RDV dans calendrier synchronisé
Réponses
5
Affichages
882
barbiturix
B
P
  • Résolu(e)
Microsoft 365 VBA_Classement automatique des documents à partir d'un répertoire fixe vers répertoire variable
2
Réponses
24
Affichages
2 K
pulelian
P
J
  • Question
XL 2016 Exporter les données d'un rendez-vous Outlook vers Excel
Réponses
0
Affichages
2 K
Julius26
J
N
  • Question
Autres Incorporer date dans mail via userform calendrier
Réponses
0
Affichages
632
nouun
N
roby
  • Question
XL 2016 Mise à jour calendrier partagé Outlook depuis Excel
Réponses
0
Affichages
2 K
roby
roby
W
  • Question
Microsoft 365 Placer un RV dans l'agenda Outlook sur calendrier secondaire
Réponses
4
Affichages
3 K
chich
C

Membres actuellement en ligne

13 membres et 121 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 112
Messages
2 085 415
Membres
102 885
dernier inscrit
AISSOU