0

我需要在 Outlook 中选择会议并只接受我选择的会议然后删除它们并且不向发件人发送通知

所以我像往常一样在谷歌上搜索，我发现了关于如何做的批量信息，但令人惊讶的是，所有这些信息都是自动接受或每次点击 1 次会议

所以我试图自己写它，但我不知道 VBA 如此笨拙，所以废话它不起作用 hhh

这是我使用的功能：

        Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application

    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select

    Set objApp = Nothing
End Function

这是100％的工作

现在接受会议的代码：

    Sub Accept()

Dim oAppt As MeetingItem
Dim cAppt As AppointmentItem
Dim oRequest As MeetingItem

Dim oResponse

Set cAppt = GetCurrentItem.GetAssociatedAppointment(True)
Set oRequest = GetCurrentItem()

Set oResponse = cAppt.Respond(olMeetingAccepted, True)
cAppt.UnRead = False
cAppt.Save
Set cItem = GetCurrentItem
cItem.Delete

Set cAppt = Nothing
Set oAppt = Nothing
Set oRequest = Nothing

If errorCode = 0 Then
    MsgBox "Accepted All Selected Meetings."
Else
    MsgBox "Program exited with error code " & errorCode & "."
End If

End Sub

现在，如果我选择一个会议，它正在工作，但同时进行多项选择，它只适用于所选时间的第一项

我尝试做这样的事情：

    Sub Accept()

Dim oAppt As MeetingItem
Dim cAppt As AppointmentItem
Dim oRequest As MeetingItem

Dim oResponse

Set cAppt = GetCurrentItem.GetAssociatedAppointment(True)
Set oRequest = GetCurrentItem()

For i = oRequest To 1 Step -1
Set oResponse = cAppt.Respond(olMeetingAccepted, True)
cAppt.UnRead = False
cAppt.Save
Set cItem = GetCurrentItem
cItem.Delete
Next


Set cAppt = Nothing
Set oAppt = Nothing
Set oRequest = Nothing

If errorCode = 0 Then
    MsgBox "Accepted All Selected Meetings."
Else
    MsgBox "Program exited with error code " & errorCode & "."
End If

End Sub

但它不起作用：D

4

2 回答 2

0

线索在Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)

GetCurrentItem 将返回一项。

遍历选择中的所有项目”

Option Explicit

Private Sub IterateMultipleSelectedItems()

    Dim cItem As Object
    Dim i As Long

    ' Process multiple selected items
    For i = ActiveExplorer.Selection.count To 1 Step -1

        Set cItem = ActiveExplorer.Selection(i)

        If cItem.Class = olMeetingRequest Then
            Debug.Print cItem.Subject
            ' Accept code without GetCurrentItem
        End If

    Next

ExitRoutine:
    Set cItem = Nothing

End Sub

接受代码替换GetCurrentItem为ActiveExplorer.Selection(i)：

Option Explicit

Sub IterateMultipleSelectedItems2()

    Dim cItem As Object
    Dim cAppt As AppointmentItem
    Dim oResponse As Object
    Dim i As Long

    ' Process multiple selected items
    For i = ActiveExplorer.Selection.count To 1 Step -1

        Set cItem = ActiveExplorer.Selection(i)

        If cItem.Class = olMeetingRequest Then

            Debug.Print cItem.Subject

            ' Accept code without GetCurrentItem
            Set cAppt = cItem.GetAssociatedAppointment(True)
            Set oResponse = cAppt.Respond(olMeetingAccepted, True)

            cItem.unread = False
            cItem.Delete

            Set cAppt = Nothing

        End If

        Set cItem = Nothing

    Next

End Sub
于 2018-07-10T21:24:01.113 回答
0

像这样 ？

Option Explicit

 Sub IterateMultipleSelectedItems()

    Dim cItem As Object
    Dim i As Long

    ' Process multiple selected items
    For i = ActiveExplorer.Selection.Count To 1 Step -1

        Set cItem = ActiveExplorer.Selection(i)

        If cItem.Class = olMeetingRequest Then
            Debug.Print cItem.Subject
            ' Accept code without GetCurrentItem

                cItem = cItem.Respond(olMeetingAccepted, True)
                cItem.UnRead = False
                cItem.Delete

                Set cItem = Nothing
                Set cItem = Nothing
                Set cItem = Nothing

                    If errorCode = 0 Then
                        'MsgBox "Accepted All Selected Meetings."
                    Else
                        MsgBox "Program exited with error code " & errorCode & "."
                    End If

        End If

    Next

ExitRoutine:
    Set cItem = Nothing

End Sub
于 2018-07-11T09:12:07.380 回答