Question

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

ThisOutlookSession中的事件处理程序

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

模块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的处理方式有些细微变化-但是我在搜索中没有发现任何东西...

Answer 1

会议请求保持不变。然后得出的结论是取消原始请求并发送新请求。

.Send不会触发Application_ItemSend。

在ThisOutlookSession

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

Outlook VBA-更新约会持续时间

1 个答案: