Envoie automatique de rendez-vous outllook

**Slowdown** · 03/05/2018, 18h13

Bonjour à tous ceux qui me répondront dans le but de m'aider.

Voici ce que je sais faire:
Envoyer automatiquement des invitations Outlook via un email à partir d'un fichier Excel. C'est-à-dire que quand je clique sur l'adresse mail de machin@hotmail.fr du fichier excel ça envoie automatiquement un mail.

Concernant la partie du haut j'arrive à le faire via une macro donc aucun soucis.

Maintenant le problème ou je bloque:

Grosso modo :
Quand j'envoie un mail à une personne avec un fichier Excel, je veux qu'en ouvrant le fichier Excel, le destinataire reçoit une demande de réunion outlook (avec acceptation automatique si possible)

J'espère avoir été clair. Si ce n'est pas le cas je pourrais développer

Merci d'avance

**Jean-Philippe André** · 03/05/2018, 18h54

Bonjour,

tu souhaites que l'invitation soit créée à l'ouverture d'un classeur excel ou bien sur un clic particulier ?

Quand j'envoie un mail à une personne avec un fichier Excel, je veux qu'en ouvrant le fichier Excel, le destinataire reçoit une demande de réunion outlook (avec acceptation automatique si possible)

l'acceptation automatique c'est plutôt intrusif comme méthode, non

**Slowdown** · 04/05/2018, 09h32

Bonjour merci de m'avoir répondu.

En effet c'est un peu "intrusif" mais je souhaite cela

**Slowdown** · 04/05/2018, 12h59

Bonjour,

tu souhaites que l'invitation soit créée à l'ouverture d'un classeur excel ou bien sur un clic particulier ?

Je souhaite que l'invitation soit créée à l'ouverture d'un classeur Excel.

**Jean-Philippe André** · 04/05/2018, 16h00

Ok,

Sais-tu déjà comment créer une invitation en VBA ?

**Slowdown** · 04/05/2018, 19h09

Bonjour oui je sais le faire via un fichier Excel. Mais j'ai laissé la macro à mon bureau. Je pourrais la poster lundi

**Slowdown** · 07/05/2018, 11h18

Voici la macro:

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
Option Explicit
 
Sub Convoquer_par_ICS()
 
' ===========
' paramétrage
Const col_date = 2    ' numéro des colonnes où se trouvent les informations
Const col_debut = 3
Const col_fin = 4
Const col_action = 5  ' servira de test (envoi fichier .ics si vide), sinon mémorise l'action
 
Const titre = "Réunion de service"
Const texte = "Merci"
 
Const destinataire = "tartenpion@hotmail.fr" ' le(s) destinataire(s) de ces invitations
' fin paramétrage
' ===============
 
Dim messagerie As Object
Dim email As Object
Dim cel As Object
Dim chemin As String
chemin = Environ("temp")
 
Set messagerie = CreateObject("Outlook.Application")
 
With ActiveSheet
    For Each cel In .Range("A2:" & "A" & .Range("A" & Application.Rows.Count).End(xlUp).Row)
        If cel.Value <> "" And cel.Offset(0, -1 + col_action).Value = "" Then
            If cel.Offset(0, -1 + col_date) < Now() Then
                cel.Offset(0, -1 + col_action) = "date échue"
            ElseIf cel.Offset(0, -1 + col_debut) = "" Or cel.Offset(0, -1 + col_fin) = "" Then
                cel.Offset(0, -1 + col_action) = ""
            Else
 
                Close #1
                Open chemin & "\invitation.ics" For Output As #1
 
                Print #1, "BEGIN:VCALENDAR"
                Print #1, "BEGIN:VEVENT"
                Print #1, "DTSTART:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_debut), "HHMMSS") ' & "Z"
                Print #1, "DTSTAMP:" & Application.Text(Now(), "YYYYMMDD") & "T" & Application.Text(Now(), "HHMMSS") ' & "Z"
                Print #1, "DTEND:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_fin), "HHMMSS") ' & "Z"
                Print #1, "LOCATION;ENCODING=QUOTED-PRINTABLE:" & cel.Value
                Print #1, "UID:"
                Print #1, "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & titre
                Print #1, "DESCRIPTION;ENCODING=QUOTED-PRINTABLE:" & texte
                Print #1, "PRIORITY:3"
                Print #1, "SEQUENCE:0"
                Print #1, "BEGIN:VALARM"
                Print #1, "TRIGGER:-PT30M"
                Print #1, "ACTION:DISPLAY"
                Print #1, "DESCRIPTION:Rappel " & titre
                Print #1, "END:VALARM"
                Print #1, "END:VEVENT"
                Print #1, "END:VCALENDAR"
 
                Close #1
 
                Set email = messagerie.CreateItem(0)
                With email
                    .To = destinataire
                    .Subject = titre
                    .body = texte
                    .Attachments.Add chemin & "\invitation.ics"
                    .send
                End With
                Set email = Nothing
 
                cel.Offset(0, -1 + col_action).Value = "Mail préparé par " & Environ("UserName") & " le " & Application.Text(Now(), "DD/MM/YYYY HH:MM")
 
            End If
        End If
        Cells(cel.Row + 1, 1).Select
    Next cel
End With
 
Set messagerie = Nothing
 
On Error Resume Next
Kill chemin & "\invitation.ics"
 
End Sub

Voilà

**Jean-Philippe André** · 07/05/2018, 17h41

Salut,

il faut simplement lancer cette macro lors de l'ouverture du classeur

A mettre donc dans Workbook_Open()

**Slowdown** · 11/05/2018, 10h10

Bonjour,

merci de votre retour.

A un moment vous énoncez:
A mettre donc dans Workbook_Open()

C'est-à-dire ? Je ne comprends pas ou ce champ apparaît

**Jean-Philippe André** · 11/05/2018, 14h40

Dans ton classeur Excel

https://silkyroad.developpez.com/VBA...asseur/#LII-12

**Slowdown** · 11/05/2018, 18h26

Merci je viens de voir que suis je maladroit :s

Du coup c'est là que je coince:

Quand j'envoie un mail à une personne avec un fichier Excel, je veux qu'en ouvrant le fichier Excel, le destinataire reçoit une demande de réunion outlook (avec acceptation automatique si possible)

A l'heure actuelle quand je le fais, la personne doit cliquer sur la macro pour avoir le rendez-vous et ensuite elle doit accepter.

Or ce que je veux c'est qu'en ouvrant le fichier, cela lui ajoute un rendez vous sur Outlook.

J'espère qu'on m'a compris

**Jean-Philippe André** · 11/05/2018, 18h28

Quel est ton code dans Excel présentement ?

**Slowdown** · 22/05/2018, 08h45

Bonjour désolé du laps de temps j'étais en vacances :s

voici le code en 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
Private Sub Workbook_Open()
Option Explicit
 
Sub Convoquer_par_ICS()
 
' ===========
' paramétrage
Const col_date = 2    ' numéro des colonnes où se trouvent les informations
Const col_debut = 3
Const col_fin = 4
Const col_action = 5  ' servira de test (envoi fichier .ics si vide), sinon mémorise l'action
 
Const titre = "Petit déjeuner"
Const texte = "Merci"
 
Const destinataire = "moi@moi.fr" ' le(s) destinataire(s) de ces invitations
' fin paramétrage
' ===============
 
Dim messagerie As Object
Dim email As Object
Dim cel As Object
Dim chemin As String
chemin = Environ("temp")
 
Set messagerie = CreateObject("Outlook.Application")
 
With ActiveSheet
    For Each cel In .Range("A2:" & "A" & .Range("A" & Application.Rows.Count).End(xlUp).Row)
        If cel.Value <> "" And cel.Offset(0, -1 + col_action).Value = "" Then
            If cel.Offset(0, -1 + col_date) < Now() Then
                cel.Offset(0, -1 + col_action) = "date échue"
            ElseIf cel.Offset(0, -1 + col_debut) = "" Or cel.Offset(0, -1 + col_fin) = "" Then
                cel.Offset(0, -1 + col_action) = ""
            Else
 
                Close #1
                Open chemin & "\invitation.ics" For Output As #1
 
                Print #1, "BEGIN:VCALENDAR"
                Print #1, "BEGIN:VEVENT"
                Print #1, "DTSTART:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_debut), "HHMMSS") ' & "Z"
                Print #1, "DTSTAMP:" & Application.Text(Now(), "YYYYMMDD") & "T" & Application.Text(Now(), "HHMMSS") ' & "Z"
                Print #1, "DTEND:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_fin), "HHMMSS") ' & "Z"
                Print #1, "LOCATION;ENCODING=QUOTED-PRINTABLE:" & cel.Value
                Print #1, "UID:"
                Print #1, "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & titre
                Print #1, "DESCRIPTION;ENCODING=QUOTED-PRINTABLE:" & texte
                Print #1, "PRIORITY:3"
                Print #1, "SEQUENCE:0"
                Print #1, "BEGIN:VALARM"
                Print #1, "TRIGGER:-PT30M"
                Print #1, "ACTION:DISPLAY"
                Print #1, "DESCRIPTION:Rappel " & titre
                Print #1, "END:VALARM"
                Print #1, "END:VEVENT"
                Print #1, "END:VCALENDAR"
 
                Close #1
 
                Set email = messagerie.CreateItem(0)
                With email
                    .To = destinataire
                    .Subject = titre
                    .body = texte
                    .Attachments.Add chemin & "\invitation.ics"
                    .send
                End With
                Set email = Nothing
 
                cel.Offset(0, -1 + col_action).Value = "Mail préparé par " & Environ("UserName") & " le " & Application.Text(Now(), "DD/MM/YYYY HH:MM")
 
            End If
        End If
        Cells(cel.Row + 1, 1).Select
    Next cel
End With
 
Set messagerie = Nothing
 
On Error Resume Next
Kill chemin & "\invitation.ics"
 
End Sub

**Oliv-** · 01/06/2018, 13h53

Je suis pas sûr d'avoir compris ce que tu veux faire !

tu as un fichier excel, qui te permet d'envoye un autre fichier exel par email et quand la personne ouvre ce dernier ca doit envoyer une invitation à une autre personne ?

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
Private Sub Workbook_Open()
 
' ===========
' paramétrage
Const col_date = 2    ' numéro des colonnes où se trouvent les informations
Const col_debut = 3
Const col_fin = 4
Const col_action = 5  ' servira de test (envoi fichier .ics si vide), sinon mémorise l'action
 
Const titre = "Petit déjeuner"
Const texte = "Merci"
 
Const destinataire = "moi@moi.fr" ' le(s) destinataire(s) de ces invitations
' fin paramétrage
' ===============
 
Dim messagerie As Object
Dim email As Object
Dim cel As Object
Dim chemin As String
chemin = Environ("temp")
 
Set messagerie = CreateObject("Outlook.Application")
 
With ActiveSheet
    For Each cel In .Range("A2:" & "A" & .Range("A" & Application.Rows.Count).End(xlUp).Row)
        If cel.Value <> "" And cel.Offset(0, -1 + col_action).Value = "" Then
            If cel.Offset(0, -1 + col_date) < Now() Then
                cel.Offset(0, -1 + col_action) = "date échue"
            ElseIf cel.Offset(0, -1 + col_debut) = "" Or cel.Offset(0, -1 + col_fin) = "" Then
                cel.Offset(0, -1 + col_action) = ""
            Else
 
                Close #1
                Open chemin & "\invitation.ics" For Output As #1
 
                Print #1, "BEGIN:VCALENDAR"
                Print #1, "BEGIN:VEVENT"
                Print #1, "DTSTART:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_debut), "HHMMSS") ' & "Z"
                Print #1, "DTSTAMP:" & Application.Text(Now(), "YYYYMMDD") & "T" & Application.Text(Now(), "HHMMSS") ' & "Z"
                Print #1, "DTEND:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_fin), "HHMMSS") ' & "Z"
                Print #1, "LOCATION;ENCODING=QUOTED-PRINTABLE:" & cel.Value
                Print #1, "UID:"
                Print #1, "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & titre
                Print #1, "DESCRIPTION;ENCODING=QUOTED-PRINTABLE:" & texte
                Print #1, "PRIORITY:3"
                Print #1, "SEQUENCE:0"
                Print #1, "BEGIN:VALARM"
                Print #1, "TRIGGER:-PT30M"
                Print #1, "ACTION:DISPLAY"
                Print #1, "DESCRIPTION:Rappel " & titre
                Print #1, "END:VALARM"
                Print #1, "END:VEVENT"
                Print #1, "END:VCALENDAR"
 
                Close #1
 
                Set email = messagerie.CreateItem(0)
                With email
                    .To = destinataire
                    .Subject = titre
                    .body = texte
                    .Attachments.Add chemin & "\invitation.ics"
                    .send
                End With
                Set email = Nothing
 
                cel.Offset(0, -1 + col_action).Value = "Mail préparé par " & Environ("UserName") & " le " & Application.Text(Now(), "DD/MM/YYYY HH:MM")
 
            End If
        End If
        Cells(cel.Row + 1, 1).Select
    Next cel
End With
 
Set messagerie = Nothing
 
On Error Resume Next
Kill chemin & "\invitation.ics"
 
End Sub

**Slowdown** · 12/06/2018, 12h52

Ce que je souhaite exactement faire:

Créer un fichier Excel avec une macro.
L'envoyer par mail à une autre personne et quand cette dernière l'ouvre, cela va lui créer une invitation sur outlook grâce à la macro

**Oliv-** · 13/06/2018, 15h14

Et pourquoi pas lui envoyer directement cette invitation ?

**Slowdown** · 14/06/2018, 12h08

Tout simplement car je veux que ça lui crée "impose" sans qu'il puisse refuser ou mettre en provisoire

**Oliv-** · 14/06/2018, 12h37

Mouais ....

Il faut quand même que des conditions soient réunies pur que cela marche, déjà il doit ouvrir le fichier excel et activer les macros !

il ne faut pas créer un Email mais directement un rdv

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
Sub CreateAppt()
    Dim myItem As Object
    Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient
 
    Set myItem = Application.CreateItem(olAppointmentItem)
    myItem.MeetingStatus = olMeeting
    myItem.Subject = "Strategy Meeting"
    myItem.Location = "Conf Rm All Stars"
    myItem.Start = #9/24/2009 1:30:00 PM#
    myItem.Duration = 90
    Set myRequiredAttendee = myItem.Recipients.Add("Nate Sun")
    myRequiredAttendee.Type = olRequired
    Set myOptionalAttendee = myItem.Recipients.Add("Kevin Kennedy")
    myOptionalAttendee.Type = olOptional
    Set myResourceAttendee = myItem.Recipients.Add("Conf Rm All Stars")
    myResourceAttendee.Type = olResource
    myItem.Display
    myItem.Send
End Sub

**Slowdown** · 14/06/2018, 17h42

merci mais quand je test la macro le destinataire doit accepter l'invit.

Je veux l'imposer c'est-à-dire que l'invit se greffe automatiquement dans son calendrier

**Oliv-** · 15/06/2018, 09h44

donc c'est plutot un RDV qu'une réunion.

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
Sub CreateAppt()
    Dim myItem As Object
    Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient
 
    Set myItem = Application.CreateItem(olAppointmentItem)
    myItem.MeetingStatus = olNonMeeting
    myItem.Subject = "Strategy Meeting"
    myItem.Location = "Conf Rm All Stars"
    myItem.Start = #6/15/2018 1:30:00 PM#
    myItem.Duration = 90
 
    'pour l'afficher
    'myItem.Display
    myItem.Save
End Sub

si tu as les droits d'écriture/ création dans l'agenda de la personne tu peux directement lui créer le rdv.

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
Sub Creation_rdv_autre_calendrier()
    Dim myNamespace As Outlook.NameSpace
    Dim myRecipient As Outlook.Recipient
    Dim CalendarFolder As Outlook.Folder
 
    Set myNamespace = Application.GetNamespace("MAPI")
    Set myRecipient = myNamespace.CreateRecipient("TOTO")
    myRecipient.Resolve
    If myRecipient.Resolved Then
 
        Set CalendarFolder = _
        myNamespace.GetSharedDefaultFolder _
                             (myRecipient, olFolderCalendar)
 
        Dim myItem As Object
        Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient
 
        Set myItem = CalendarFolder.Items.add
        myItem.MeetingStatus = olNonMeeting
        myItem.Subject = "Strategy Meeting"
        myItem.Location = "Conf Rm All Stars"
        myItem.Start = #6/15/2018 1:30:00 PM#
        myItem.Duration = 90
 
        'pour l'afficher
        'myItem.Display
        myItem.Save
 
    Else
        MsgBox "erreur"
    End If
End Sub

Envoie automatique de rendez-vous outllook

VBA Outlook

Discussions similaires

Partager

Partager