展望会议取消使用VBA

Question

有些情况下，我们忘记取消我们计划的会议，可能是由于缺少重要人物，或者可能是由于时间不够。但在很多情况下，我们忘记从展望中取消会议。因此，我正在寻找一个VBA代码，如果会议很好，或者要取消会议，会向组织者开会，如果要取消会发出取消邮件。请帮我解决一下这个。提前致谢！ :)

Answer 1

利用@alina以及在网络上的其他一些宏的代码后，我想出了这我在这里共享同一个解决方案。

Public WithEvents objReminders As Outlook.Reminders 

Sub Initialize_handler() 

    Set objReminders = Application.Reminders 
End Sub 

Private Sub objReminders_ReminderFire(ByVal ReminderObject As reminder) 

Dim oApp As Outlook.Application 
Dim oNameSpace As Outlook.NameSpace 
Dim oApptItem As Outlook.AppointmentItem 
Dim oFolder As Outlook.MAPIFolder 
Dim oMeetingoApptItem As Outlook.MeetingItem 
Dim oObject As Object 
Dim iUserReply As VbMsgBoxResult 
Dim sErrorMessage As String 
MsgBox (VBA.Time) 
On Error Resume Next 
' check if Outlook is running 
Set oApp = GetObject("Outlook.Application") 
If Err <> 0 Then 
    'if not running, start it 
    Set oApp = CreateObject("Outlook.Application") 
End If 

On Error GoTo Err_Handler 
Set oNameSpace = oApp.GetNamespace("MAPI") 
Set oFolder = oNameSpace.GetDefaultFolder(olFolderCalendar) 

For Each oObject In oFolder.Items 
    If oObject.Class = olAppointment Then 
    Set oApptItem = oObject 
     If ReminderObject.Caption = oApptItem.Subject Then 
     If oApptItem.Organizer = Outlook.Session.CurrentUser Then 
     iUserReply = MsgBox("Meeting found:-" & vbCrLf & vbCrLf _ 
      & Space(4) & "Date/time (duration): " & Format(oApptItem.Start, "dd/mm/yyyy hh:nn") _ 
      & " (" & oApptItem.Duration & "mins)" & Space(10) & vbCrLf _ 
      & Space(4) & "Subject: " & oApptItem.Subject & Space(10) & vbCrLf _ 
      & Space(4) & "Location: " & oApptItem.Location & Space(10) & vbCrLf & vbCrLf _ 
      & "Do you want to continue with the meeting?", vbYesNo + vbQuestion + vbDefaultButton1, "Meeting confirmation") 
     If iUserReply = vbNo Then 
      oApptItem.MeetingStatus = olMeetingCanceled 
      oApptItem.Save 
      oApptItem.Send 
      oApptItem.Delete 
      End If 
      End If 
    End If 
    End If 

Next oObject 

Set oApp = Nothing 
Set oNameSpace = Nothing 
Set oApptItem = Nothing 
Set oFolder = Nothing 
Set oObject = Nothing 

Exit Sub 

Err_Handler: 
sErrorMessage = Err.Number & " " & Err.Description 

End Sub 

Answer 2

我发现这个here

Public Function DeleteAppointments(ByVal subjectStr As String) 

    Dim oOL As New Outlook.Application 
    Dim oNS As Outlook.NameSpace 
    Dim oAppointments As Object 
    Dim oAppointmentItem As Outlook.AppointmentItem 
    Dim iReply As VbMsgBoxResult 

    Set oNS = oOL.GetNamespace("MAPI") 
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar) 
    Count = oAppointments.Items.Count 'for test purposes 

    For Each oAppointmentItem In oAppointments.Items 
     If InStr(oAppointmentItem.Subject, subjectStr) > 0 Then 
     iReply = msgbox("Appointment found:" & vbCrLf & vbCrLf _ 
      & Space(4) & "Date/time: " & Format(oAppointmentItem.Start, "dd/mm/yyyy hh:nn") & vbCrLf _ 
      & Space(4) & "Subject: " & oAppointmentItem.Subject & Space(10) & vbCrLf & vbCrLf _ 
      & "Delete this appointment?", vbYesNo + vbQuestion + vbDefaultButton2, "Delete Appointment?") 
     If iReply = vbYes Then oAppointmentItem.Delete 
      oAppointmentItem.Delete 
     End If 
    Next 

    Set oAppointmentItem = Nothing 
    Set oAppointments = Nothing 
    Set oNS = Nothing 
    Set oOL = Nothing 

End Function