bonjour
j ai une macro excel qui ecrit des rendez vous dans mon calendrier outlook
et j ai dans outlook une macro qui quand je crée un rdv,en fait la copie vers un autre calendrier partagé
j aimerais savoir comment faire pour piloter cette 2 eme macro directement depuis excel afin que mes rdv créés à partir de la premiere macro oit automatiquement recopié vers l autre calendrier sans que j ai à le faire à la main
merci d avance
j ai une macro excel qui ecrit des rendez vous dans mon calendrier outlook
Code:
Sub ajoute_rdv_agenda()
Dim MonOutlook As New Outlook.Application
Dim rdv As Outlook.AppointmentItem
Dim nbjour As Outlook.RecurrencePattern
Set rdv = MonOutlook.CreateItem(olAppointmentItem)
With rdv
.MeetingStatus = olMeeting
.Subject = "Prestation " & Range("nom_client")
.Body = Range("obj_mission")
.BusyStatus = olBusy
.Categories = Range("nom_client")
.Start = Range("date_mission") + TimeSerial(8, 0, 0)
.Duration = 540
.ReminderSet = False
Set nbjour = rdv.GetRecurrencePattern
With nbjour
.RecurrenceType = olRecursDaily
.PatternStartDate = Range("date_mission")
.PatternEndDate = Range("date_fin")
rdv.Save
End With
End With
'MonOutlook.Quit
Set MonOutlook = Nothing
Set rdv = Nothing
et j ai dans outlook une macro qui quand je crée un rdv,en fait la copie vers un autre calendrier partagé
Code:
Public Sub CopyRDV()
On Error GoTo AddAppt_Err
Dim OutObj As Outlook.Application
Dim MyRDV As Outlook.AppointmentItem
Dim OutAppt As Outlook.AppointmentItem
Dim MyCalendarItem As Outlook.Items
Dim MyCalendarFolder As Outlook.MAPIFolder
Set OutObj = CreateObject("Outlook.Application")
Set MyRDV = ActiveInspector.CurrentItem
Set MyCalendarFolder = OutObj.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Folders.Item("calendrier2")
MyRDV.Close olPromptForSave
If MyRDV.Saved Then
Set OutAppt = MyRDV.Copy
With OutAppt
If MyRDV.BusyStatus = olBusy Then _
.Subject = "Occupé"
.ReminderSet = False
.Save
End With
OutAppt.Move MyCalendarFolder
End If
Set OutObj = Nothing ' Retire de la mémoire les objets créer
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
merci d avance