Outlook VBA接受多个选定的会议不自动接受吗?

时间:2018-07-10 15:44:12

标签: vba outlook

我需要在Outlook中选择会议,仅接受我选择的会议,然后将其删除,并且不向发送方发送通知

所以我像往常一样在谷歌上搜索,发现批量处理方法的信息,但令人惊讶的是,它们都是自动接受或每次点击1次会议

所以我试图自己编写它,但是我不知道VBA这么糟糕,所以它不起作用了……

这是我使用的功能:

        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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分: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