展望會議取消使用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