使用 VBA 取消 Outlook 会议

Question

在某些情况下，我们忘记取消预定的会议，可能是因为重要的人不在，或者可能是因为时间不够。但在许多情况下，我们忘记从 Outlook 取消会议。因此，我正在寻找一个 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