Discussion :

[xico8]

Bonjour,

Je vous expose la situation : j'ai besoin de créer des RDV dans OUTLOOK depuis un fichier Excel en reprenant les infos présentes dans différentes lignes/colonnes d'une feuille.

Le code fonctionne normalement, le souci que je rencontre est qu'il ne fonctionne que sur mon calendrier, et quand je veux changer de calendrier avec Set Recipient = Namespace.CreateRecipient("tata@tata.fr"), les RDV se créent toujours dans mon calendrier Outlook ex : "toto@toto.fr".

Ces adresses sont évidemment bidons, mais les vraies adresses de calendrier correspondent à des calendrier sur lesquels j'ai bien tous les droits d'écriture (je peux ajouter des RDV à la main sans difficulté dans ces cal).

Voici mon code :

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
 
 
Sub ajoutCalendrierTest()
 
    Dim objOutlook, Namespace As Object
    'Dim choix As Integer
    Dim Recipient As Outlook.Recipient
    Dim OutAppt As Outlook.AppointmentItem
 
 
    Dim derlignetest, i As Long
    Dim datedeb As Date
    Dim datefin As Date
 
    Set objOutlook = New Outlook.Application
    Set Namespace = Outlook.GetNamespace("MAPI")
 
    Set Recipient = Namespace.CreateRecipient("toto@toto.fr")
    'Recipient.Resolve
 
    Application.ScreenUpdating = False ' Masque le déroulement de la macro
    Application.DisplayAlerts = False '
 
 
    Sheets("Test").Select
 
With Sheets("Test")
    derlignetest = Sheets("Test").Range("A200000").End(xlUp).Row
 
    For i = 2 To derlignetest
     '!!! Faire un controle pour savoir si RDV déjà indiqué !!!
 
        datedeb = Range("C" & i)
        datefin = Range("D" & i)
 
        Set OutAppt = objOutlook.CreateItem(olAppointmentItem) 'Objet RDV Outlook
        With OutAppt
            .Subject = Sheets("Test").Range("B" & i) 'Objet du mail
            .Body = "Nombre de CR impactées : " & Sheets("Test").Range("L" & i) & Chr(10) & Chr(10) & "Nom des CR : " & Sheets("Test").Range("G" & i) & Chr(10) & Chr(10) & "Nom du service impacté : " & Sheets("Test").Range("E" & i) & Chr(10) & Chr(10) & "Remarques : " & Chr(10) & Sheets("Test").Range("K" & i) & Chr(10) & Chr(10) & "Interruption de service : " & Sheets("Test").Range("H" & i) & Chr(10) & Chr(10) & "Relations Partenaires : " & Sheets("Test").Range("I" & i) 'Corps du message
            .Start = datedeb 'date début d'intervention
            .End = datefin 'date fin d'intervention
 
            '.Duration =  datefin - datedeb pas nécessaire
            .ReminderSet = False 'on ne met pas de rappel
            .Save 'enregistrement du RDV
        End With
        On Error Resume Next
 
      Next i
 
End With
 
    Set objOutlook = Nothing
    Set Namespace = Nothing
    Set Recipient = Nothing
 
    Sheets("Test").Select
 
End Sub

Pouvez-vous me dire comment accéder à un autre calendrier via ce code, SVP ?

En vous remerciant par avance,

Xico

[Frank]

Bonjour,

avec ce code, tu dois atteindre le client Outlook sur ton pc, pas le serveur Outlook.

C'est normal que tu ne puisses pas mettre à jour une autre messagerie.

[xico8]

Que dois-je modifier selon vous pour atteindre le serveur de messagerie ?

[Frank]

ci-joint un example de code.

une recherche sur le forum t'aidera à avancer sur le sujet, j'en suis certain.

[xico8]

Merci pour le coup de main, mais je ne m'en sors pas. Je ne suis pas certain qu'il s'agisse d'une anomalie de connexion au serveur Exchange ou qu'il faille indiquer en dur une connexion au serveur Exchange.
La connexion au calendrier par défaut se fait directement sur le mien quelque soit le nom de calendrier que j'indique.
Les calendriers que je veux atteindre sont partagés, et j'ai tous les droits dessus...

Si vous aviez une autre idée, SVP ?

[Frank]

Hello,

Regardes ce post, je pense qu'il peut t'aider.

Enormément de problématiques sont abordés sur ce forum chaque jour, il ne faut pas hésiter à utiliser la fonction de recherche, la FAQ, les tutoriels...