Bonjour à tous,
Je souhaite faciliter le suivi et la communication des absence pour notre secrétaire, mais j'ai du mal sur un point.....
Je souhaite créer une tache Outlook lorsque je créais un nouveau congé dans "Liste Congés", j'ai récupérer un code que j'ai essayé d'adapter mais ça ne fonctionne pas .....
Dans l'idéal j'aurais souhaité que les taches se créaient dans un calendrier partagé "Absences".
Merci d'avance pour le temps que vous pourrez m'accorder.
******************************************************************************************************************
Sub Création_RDV_Calendrier()
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim Fld As Outlook.MAPIFolder
derl = Range("B" & Rows.Count).End(xlUp).Row
For i = 4 To derl 'démarre à la ligne 4 jusqu'à la première cellule vide
If (ThisWorkbook.Sheets("Liste Congés").Range("N" & i) <> "") Then
Set Fld = getDefaultFolderFromUser("moncomptedemessagerie", olFolderCalendar) 'compte outlook + calendrier
Set Rdv = Fld.Items.Add(olAppointmentItem)
With Rdv
.MeetingStatus = olMeeting
.Subject = Cells(i, 2).Value & " " & Cells(i, 2).Value 'Intitulé + Nom de l'agent
.Body = Cells(i, 11).Value 'Observation
'.Location =
.Start = Range("C" & i).Value & Range("H" & i).Value 'Date et heure de début
.Duration = Range("J" & i).Value 'Durée en minutes
.Save
End With
Range("N" & i).Value = Now 'Flag d'envoi
Next
Set OkApp = Nothing
End Sub
Je souhaite faciliter le suivi et la communication des absence pour notre secrétaire, mais j'ai du mal sur un point.....
Je souhaite créer une tache Outlook lorsque je créais un nouveau congé dans "Liste Congés", j'ai récupérer un code que j'ai essayé d'adapter mais ça ne fonctionne pas .....
Dans l'idéal j'aurais souhaité que les taches se créaient dans un calendrier partagé "Absences".
Merci d'avance pour le temps que vous pourrez m'accorder.
******************************************************************************************************************
Sub Création_RDV_Calendrier()
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim Fld As Outlook.MAPIFolder
derl = Range("B" & Rows.Count).End(xlUp).Row
For i = 4 To derl 'démarre à la ligne 4 jusqu'à la première cellule vide
If (ThisWorkbook.Sheets("Liste Congés").Range("N" & i) <> "") Then
Set Fld = getDefaultFolderFromUser("moncomptedemessagerie", olFolderCalendar) 'compte outlook + calendrier
Set Rdv = Fld.Items.Add(olAppointmentItem)
With Rdv
.MeetingStatus = olMeeting
.Subject = Cells(i, 2).Value & " " & Cells(i, 2).Value 'Intitulé + Nom de l'agent
.Body = Cells(i, 11).Value 'Observation
'.Location =
.Start = Range("C" & i).Value & Range("H" & i).Value 'Date et heure de début
.Duration = Range("J" & i).Value 'Durée en minutes
.Save
End With
Range("N" & i).Value = Now 'Flag d'envoi
Next
Set OkApp = Nothing
End Sub