2017-03-08 50 views
1

我一直在使用vba的Outlook的小項目。最終目標是與兩位收件人設置約會/會面,並將其設置爲整天。那麼,我需要它在我的日曆中找到我的會議,並將其設置爲不是一整天的事件。展望VBA會議調整

我已經到了可以將會議發送給收件人的地步,並且可以根據需要顯示。唯一的障礙是讓我的代碼按日期和時間找到相同的會議(與發送時相同),並將其從全天事件更改爲不是全天事件。到目前爲止,這是我的代碼,可以用於我目前需要的功能。

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 

回答

0

試試這個

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 

我修改這從Office開發中心:Search the Calendar for Appointments Within a Date Range that Contain a Specific Word in the Subject