Ajustements de réunion VBA Outlook

Question

J'ai travaillé sur un petit projet pour Outlook en utilisant vba. L'objectif ultime est de fixer un rendez-vous/une réunion avec deux destinataires et de le définir pour toute la journée. PUIS, j'en ai besoin pour trouver ma réunion dans mon calendrier et la définir pour ne pas être un événement toute la journée.

Je suis arrivé au point où je peux envoyer la réunion à mes destinataires et la faire apparaître comme vous le souhaitez. Le seul hic que j'ai est d'avoir mon code à trouver la même réunion par date et heure (même que quand il a été envoyé) et le changer d'être un événement toute la journée à ne pas être un événement toute la journée. Voici mon code jusqu'à présent qui fonctionne pour ce dont j'ai besoin jusqu'à présent.

Sub Appointment() 

    Dim olApt As AppointmentItem 

    Set olApp = Outlook.Application 

    Set olApt = olApp.CreateItem(olAppointmentItem) 

    With olApt 
     .Start = #3/10/2017 4:00:00 PM# 
     .End = #3/3/1017 5:00:00 PM# 
     .MeetingStatus = olMeeting 
     .AllDayEvent = True 
     .Subject = "OOO - Test" 
     .Body = "Testing Stuff" 
     .BusyStatus = olFree 
     .ReminderSet = False 
     .RequiredAttendees = "Placeholder" & ";" & " Placeholder" 
     .Save 
     .Send 
    End With 

     Set olApt = Nothing 
     Set olApp = Nothing 

End Sub 

Answer 1

Essayez cette

Function FindAppts(apptDate As Date, strSubject As String) 

Dim myDate As Date 
Dim myEnd As Date 
Dim oCalendar As Outlook.Folder 
Dim oItems As Outlook.Items 
Dim oItemsInDateRange As Outlook.Items 
Dim oFinalItems As Outlook.Items 
Dim oAppt As Outlook.AppointmentItem 
Dim strRestriction As String 

myStart = apptDate 
myEnd = DateAdd("d", 30, myStart) 

Debug.Print "Start:", myStart 
Debug.Print "End:", myEnd 

'Construct filter for the next 30-day date range 
strRestriction = "[Start] >= '" & _ 
Format$(myStart, "mm/dd/yyyy hh:mm AMPM") _ 
& "' AND [End] <= '" & _ 
Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") & "'" 

'Check the restriction string 
Debug.Print strRestriction 

Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar) 
Set oItems = oCalendar.Items 
oItems.IncludeRecurrences = False 
oItems.Sort "[Start]" 

'Restrict the Items collection for the 30-day date range 
Set oItemsInDateRange = oItems.Restrict(strRestriction) 

'Construct filter for Subject containing 'team' 
Const PropTag As String = "http://schemas.microsoft.com/mapi/proptag/" 
strRestriction = "@SQL=" & Chr(34) & PropTag _ 
    & "0x0037001E" & Chr(34) & " like '%' & strSubject & '%'" 

'Restrict the last set of filtered items for the subject 
Set oFinalItems = oItemsInDateRange.Restrict(strRestriction) 
'Sort and Debug.Print final results 
oFinalItems.Sort "[Start]" 
For Each oAppt In oFinalItems 
    Debug.Print oAppt.Start, oAppt.Subject 
    If oAppt.Start = apptDate Then 
     oAppt.Delete 
    End If 

Next 
End Function 

J'ai modifié ce Bureau du Dev Center: Search the Calendar for Appointments Within a Date Range that Contain a Specific Word in the Subject