XL 2016 avis de rdv dans mail outlook

fredl

XLDnaute Impliqué
Bonjour à tous et d'avance merci pour votre aide.

J'ai écrit une macro (utilisée à partir d'un fichier excel) qui permet de générer une trame de mail outlook avec en piece jointe un avis de rdv outlook (.ics).
Cette macro fonctionne parfaitement si et seulement si la reference "Microsoft Outlook xx.0 Object library" est activée.
Hors, je souhaiterai m'en affranchir afin de ne pas avoir à paramétrer cette ref sur tous les PC qui vont utiliser cette macro.
Pour d'autres besoin, j'ai déjà pu le faire en remplaçant "Set olApp = New Outlook.Application" par "Set olApp = GetObject(, "Outlook.Application")
Malheureusement, pour la creation d' i calendar ".ics", cela ne fonctionne pas....
Une idée?
La macro fonctionnelle est ci dessous avec ma variante (en commentaires) au tout début non fonctionnelle.
Encore merci d'avance à celui qui voudra bien trouver un peu de temps pour me débloquer la situation.

Frédéric
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Sub envoimailInterimAvecCalendar()

'////ce qui ne marche pas//////////////////////////////////////
'On Error Resume Next
'Set olApp = GetObject(, "Outlook.Application")
'If olApp Is Nothing Then 'si outlook es fermé,ouvrir outlook
' Set olApp = CreateObject("Outlook.Application")
'End If
Set olApt = olApp.CreateItem(olAppointmentItem)

'//////////////////////////////////////////////////////////////////

'/////ce qui fonctionne ci dessous avec la "ref outlook"///////
Dim olApp As Outlook.Application
Dim olApt As AppointmentItem
Set olApp = New Outlook.Application
Set olApt = olApp.CreateItem(olAppointmentItem)

'///////////////////////////////////////////////////////////////////

With olApt
.Start = "0:00 AM" & Format("29/11/2019")
.End = .Start + 2
.Subject = "Interim de S. Vxxx assuré par G. NxxxA(83812) du 29/11 au 30/11 inclu"
.Location = "N/A"
.Body = "Interim Sxxx"
.BusyStatus = olFree
.ReminderMinutesBeforeStart = 960 '16h avant minuit=8h du mat la veille
.ReminderSet = True
.Display
.SaveAs "H:\Interimxxx_29-11au30-11.ics"
.Close False
End With
Set olApt = Nothing

Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long

On Error Resume Next
Application.DisplayAlerts = False
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
wnd = FindWindow("EXCLICKYES_WND", 0&)
Res = SendMessage(wnd, uClickYes, 1, 0)

'Déclaration des objets de la messagerie
Set olApp = CreateObject("Outlook.Application")
Set Mail = olApp.CreateItem(olMailItem)

'On prépare l'envoi de Mail
With Mail
.SentOnBehalfOfName = SentOnName
'Mettre ici le ou les destinataires
.To = "flesbre@cea.fr"
.Subject = "Intérim Sxxx 22/07/19"
.Body = ""
.Body = "Bonjour," & vbLf & vbLf & _
"Durant son absence (congés) du 22 juillet au 14 août 2019 inclus," & vbLf & _
"l'intérim de Sxxx en tant que Chef de laboratoire du L2CB sera assuré de la façon suivante :" & vbLf & vbLf & _
"- Du 22/07 au 26/07 : OTIN (83269)" & vbLf & vbLf & _
"Note d 'intérim signée en PJ." & vbLf & vbLf & _
"Cordialement,"

.Attachments.Add ("H:\Interimxxx_29-11au30-11.ics")
.Display
.Send
End With
Set olApp = Nothing
' Mise au repos de CLICKYES
Res = SendMessage(wnd, uClickYes, 0, 0)
'remise en place des infos
Application.DisplayAlerts = True
End Sub
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 

Discussions similaires

Réponses
2
Affichages
657

Statistiques des forums

Discussions
315 093
Messages
2 116 133
Membres
112 667
dernier inscrit
foyoman