vba - Outlook VBA - 更新约会持续时间

Question

我编写/破解了一些 VBA 代码，提示用户调整他们将要发送的约会并稍微缩短持续时间以允许会议之间的缓冲。直到今年某个时候它都运行良好......现在它没有调整发送的项目，只有我日历中的那个。

1. 中的事件处理程序ThisOutlookSession

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Cancel = Not (Module1.AUTOchangeMeetingDuration(Item))
End Sub

2. Module1模块中 的调整功能
   • 得到Item
   • 检查它是否olMeetingRequest正在发送
   • 获取AppointmentItem会议对应的
   • 调整Duration

Public Function AUTOchangeMeetingDuration(ByVal Item As Object) As Boolean
  AUTOchangeMeetingDuration = True
  If Item.Class <> olMeetingRequest Then Exit Function ' exit if not sending a meeting request
  Dim i As AppointmentItem
  Set i = Item.GetAssociatedAppointment(False)
  If i.Organizer <> "" And i.Organizer <> Application.Session.CurrentUser Then GoTo cleanup 'user is not organiser
  If i.Duration Mod 30 <> 0 Then GoTo cleanup 'duration is not round 30
  Dim x As VbMsgBoxResult
  x = MsgBox("Do you wish to adjust meeting length in accordance with meeting guidelines?" & Chr(10) & _
             "Duration will be adjusted to " & (i.Duration - 5) & "mins (from " & i.Duration & "mins)" _
            , vbYesNoCancel, "Adjust duration before Send?")
  If x = vbYes Then
    i.Duration = i.Duration - 5
  ElseIf x = vbCancel Then
    AUTOchangeMeetingDuration = False
  End If
cleanup:
  Set i = Nothing
  Exit Function
End Function

如前所述，此代码过去可以正常工作，但现在不行了。我们的 Outlook 已经更新 - 例如升级到 2016 客户端和外部 Outlook365，但我不记得时间表。猜测是GetAssociatedAppointment处理方面的一些细微变化 - 但我在搜索中没有找到任何东西......

标签： vbaoutlook

Answer 1

会议要求没有改变。那么结论就是取消原来的并发送一个新的请求。

.Send不Application_ItemSend触发。

在这个 Outlook 会话中

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Cancel = Module1.AUTOchangeMeetingDuration(Item)
    Debug.Print "Original meeting request cancelled? " & Cancel

End Sub

在常规模块中，Module1 遵循问题中的约定。

Option Explicit

Public Function AUTOchangeMeetingDuration(ByVal Item As Object) As Boolean

    Dim i As AppointmentItem
    Dim x As VbMsgBoxResult

    If Item.Class <> olMeetingRequest Then
        ' exit if not sending a meeting request
         Exit Function
    End If

    Set i = Item.GetAssociatedAppointment(False)

    If i.Organizer <> "" And i.Organizer <> Application.Session.CurrentUser Then
        'user is not organiser
        Exit Function
    End If

    If i.Duration Mod 30 <> 0 Then
        'duration is not round 30
        Exit Function
    End If

    x = MsgBox("Do you wish to adjust meeting length in accordance with meeting guidelines?" & Chr(10) & _
      "Duration will be adjusted to " & (i.Duration - 5) & "mins (from " & i.Duration & "mins)", _
      vbYesNoCancel, "Adjust duration before Send?")

    If x = vbYes Then
        i.Duration = i.Duration - 5
        'Cancel the original request which is "Item"
        AUTOchangeMeetingDuration = True

        ' Send updated request which is "i"
        ' Does not call Application_ItemSend a second time
        i.Send

    ElseIf x = vbCancel Then
        AUTOchangeMeetingDuration = True
    End If

End Function