Exportez date excel sous forme de rendez-vous dans outlook 2010

**Abardothe** · 28/02/2014, 08h01

Bonjour la communauté,

Dans le cadre de mon stage, je dois réaliserun tableau excel regroupant des dates de maintenance. Il faudrait donc que j'arrive à exporter les dates de la colonne I (de ma feuille "Feuil1") vers Outlook (2010) dans un calendrier appelé "maintenance" si possible avec un rappel 7 jours avant. Le rendez vous serait placé à 8h00 ou n'importe quelle heure de la journée avec pour nom, celui correspondant à la colonne B. Bien sûr les cellules vides ne doivenet pas créer de rendez-vous.

Je n'arrive pas à vous mettre le classeur sous forme .xlsm donc je le met sans mes macros déjà existante.

Si vous arriviez à faire ce que je demande ça m'enlèverait une bien grosse épine du pied, deux jours que je suis dessus sans rien réussir..

Merci d'avance et bonne journée

**Phil'oche** · 28/02/2014, 13h40

Salut,

Pour ce qui est de l'ajout d'évènement dans un calendrier Outlook, voilà ce que tu peux utiliser :

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
Sub NouveauRDV_Calendrier()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
 
Set Rdv = OkApp.CreateItem(olAppointmentItem)
 
With Rdv
    .MeetingStatus = olMeeting
    .Subject = "le site DVP"
    .Body = "...description ...."
    .Location = "sur le forum Office"
    .Start = #2/28/2014 2:30:00 PM#       ' Attention : format mois/jours/année
    .Duration = 30 'minutes
    .Categories = "Amis"
    .Save
End With
 
Set OkApp = Nothing
End Sub

PS : le code n'est pas de moi, mais de SilkyRoad dans la faq excel

**Abardothe** · 28/02/2014, 17h19

Salut,

Merci de ta réponse, j'avais déjà vu ce code, mais je suis incapable de le modifier pur qu'il me soit utile.

Dans mon fichier j'ai ce 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
Option Explicit
 
Sub AjoutRV()
  Dim DLig As Long, Lig As Long
  Dim OutObj As Outlook.Application
  Dim OutAppt As Outlook.AppointmentItem
  Dim DateRdv As Date, FlgRdv As Boolean
 
  ' Créer une instance d'Outlook
  Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
  With Sheets("Suivi")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 6 To DLig
      ' Vérifier si pas déjà fait
      If .Range("D" & Lig) <> "" Then
      Else
        FlgRdv = True
      End If
      ' Si le FLAG est à vrai on créé le RDV
      If FlgRdv Then
        DateRdv = Range("B" & Lig) 'date du rdv, ici prend la colonne B
        Set OutAppt = OutObj.CreateItem(olAppointmentItem)
        With OutAppt
          .Subject = "Maintenance " & Sheets("Suivi").Range("A" & Lig) & " pour le suivi " & Sheets("Suivi").Range("C" & Lig) 'sujet du rdv
          .Start = DateRdv & " 08:00 " 'Début du rendez-vous
          .Duration = 60 'durée en minute du rdv
          .ReminderSet = True 'présence ou non d'un rappel (True/False)
          .Save
        End With
        ' Créer le commentaire et inscrire Oui
        On Error Resume Next
        .Range("D" & Lig).Comment.Delete
        .Range("D" & Lig) = "Rdv créé"
        On Error GoTo 0
      End If
    Next Lig
  End With
  Set OutAppt = Nothing
End Sub

Je sais plus de qui il est, mais pas de moi en tout cas..

Mon dernier soucis serait de mettre le rendez vous dans un calendrier autre que le calendrier de base, tu saurais faire ?

Petit up,

J'ai vu qu'il fallait utiliser quelque chose de ce genre pour choisir le calendrier de destination :

Code :

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

1
2
3
4
5
6
7
8
'On choisi le calendrier
 Set myOlApp = CreateObject("Outlook.Application")
 'Concernant la ligne suivante après le ("MAPI")
 ' Folders.Item(1) : correspond au dossier Personnel
 ' Folders.Item(5) : correspond au dossier Calendrier standard
 ' Folders.Item(1) : correspond au sous calendrier, s'il y en a d'autre remplacer par le n° d'index...
 Set MyCalendar = myOlApp.GetNamespace("MAPI").Folders.Item(1).Folde rs.Item(5).Folders.Item(1).Items 'choix calendrier perso
 'Fin choix calendrier

Mais je ne comprend pas comment l'utiliser, vous pouvez m'aider ?

**Abardothe** · 03/03/2014, 21h35

Yo les gens

Je reviens en FORCE

Je touche au but, mais il me manque une ligne de code et je ne sais comment faire...

J'arrive à définir le calendrier où inscrire le rendez vou, mais je ne sais pas comment dire d'écrire le rendez-vous dans ce calendrier... C'est balo n'Est-ce pas ? Voici mon code (complet) :

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
 
Option Explicit
 
Sub AjoutRV()
  Dim DLig As Long, Lig As Long
  Dim OutObj As Outlook.Application
  Dim OutAppt As Outlook.AppointmentItem
  Dim DateRdv As Date, FlgRdv As Boolean
  Dim MyCalendar As Outlook.Items
  Dim OutlMapi As Outlook.Namespace
  Dim OutlFolder As Outlook.MAPIFolder
  Dim MyItem As Outlook.AppointmentItem
  Dim myNamespace As Outlook.Namespace
  Dim myOlApp As New Outlook.Application
  Dim MyFolder As Outlook.Items
  Dim objOutlook As New Outlook.Application
 
  ' Créer une instance d'Outlook
  Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
  With Sheets("Suivi")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 12 To DLig
      ' Vérifier si pas déjà fait
      If .Range("D" & Lig) <> "" Then
      Else
        FlgRdv = True
      End If
      ' Si le FLAG est à vrai on créé le RDV
      If FlgRdv Then
       'création du rdv
 
        Dim olns As Outlook.Namespace
        Dim MyCalendarFolder As Outlook.MAPIFolder
 
    'initialisation du NameSpace
     Set olns = objOutlook.GetNamespace("MAPI")
 
    'choix du calendrier
     Set MyCalendarFolder = olns.Folders("nicolas.****@cegetel.net").Folders("test")
     Set OutAppt = OutObj.CreateItem(olAppointmentItem)
 
 
        DateRdv = Range("B" & Lig) 'date du rdv, ici prend la colonne B
        Set OutAppt = OutObj.CreateItem(olAppointmentItem)
        With OutAppt
          .Subject = "Maintenance " & Sheets("Suivi").Range("A" & Lig) & " pour le suivi " & Sheets("Suivi").Range("C" & Lig) 'sujet du rdv
          .Start = DateRdv & " 08:00 " 'Début du rendez-vous
          .Duration = 60 'durée en minute du rdv
          .Body = Range("F" & Lig)
          .ReminderSet = True 'présence ou non d'un rappel (True/False)
          .Save
        End With
        ' Créer le commentaire et inscrire Oui
        On Error Resume Next
        .Range("D" & Lig) = "Rdv créé"
        On Error GoTo 0
      End If
    Next Lig
  End With
  Set OutAppt = Nothing
    Set MyCalendarFolder = Nothing
     Set olns = Nothing
     Set objOutlook = Nothing
 
End Sub

C'est un peu le fouilli je sais, mais auriez-vous une solution ?

Je vous met ici la partie "intéressante" du code, où on crée le rendez-vous :

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
 
        Dim olns As Outlook.Namespace
        Dim MyCalendarFolder As Outlook.MAPIFolder
 
    'initialisation du NameSpace
     Set olns = objOutlook.GetNamespace("MAPI")
 
    'Optention du calendrier en utilisant la constante (sinon mettre le nom du calendrier entre guillemets)
     Set MyCalendarFolder = olns.Folders("nicolas.piaggesi@cegetel.net").Folders("test")
     Set OutAppt = OutObj.CreateItem(olAppointmentItem)
 
 
        DateRdv = Range("B" & Lig) 'date du rdv, ici prend la colonne B
        Set OutAppt = OutObj.CreateItem(olAppointmentItem)
        With OutAppt
          .Subject = "Maintenance " & Sheets("Suivi").Range("A" & Lig) & " pour le suivi " & Sheets("Suivi").Range("C" & Lig) 'sujet du rdv
          .Start = DateRdv & " 08:00 " 'Début du rendez-vous
          .Duration = 60 'durée en minute du rdv
          .Body = Range("F" & Lig)
          .ReminderSet = True 'présence ou non d'un rappel (True/False)
          .Save
        End With

Merci d'avance et bonne soirée !

**Guy7700** · 23/05/2018, 08h11

Bonjour,

Je suis également intéressé par ce code. Est-ce que quelqu'un a trouvé une solution finalement ?

Ce type de code dépasse de loin mes maigres connaissances.

Merci à ceux qui se manifesteront.

**Menhir** · 23/05/2018, 09h00

Même si la macro est lancée sous Excel, cette question concerne la manipulation d'objets Outlook.
Tu devrais donc la placer dans la rubrique concernant ce logiciel : https://www.developpez.net/forums/f6...k/vba-outlook/

Exportez date excel sous forme de rendez-vous dans outlook 2010

Macros et VBA Excel

Discussions similaires

Partager

Partager