2017-03-08 53 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