Обновление получателей собрания с записью в ячейку - PullRequest
0 голосов
/ 01 октября 2019

У меня есть следующий код для поиска встреч в календаре Outlook, если в столбце F есть текст для отправки отмененного обновления.

Я получаю сообщение об ошибке

"в поле «Кому», «Копия» или «Скрытая копия» должна быть хотя бы одна группа имен или контактов ».

Recipients.Add указывает на ячейку с адресом электронной почты.

Это сработалоа теперь нет.

Sub DeleteMeeting()

Dim i As Long, j As Long
Dim wb              As Workbook
Dim ws              As Worksheet
Dim objOutlook      As Outlook.Application
Dim objNamespace    As Outlook.Namespace
Dim objFolder       As Outlook.MAPIFolder
Dim objAppointment  As Outlook.AppointmentItem

Set objOutlook = Outlook.Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
Set oItems = objFolder.Items
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Licences")


r = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To r
    For j = oItems.Count To 1 Step -1

        If Cells(i, 6).Value <> "" And Cells(i, 5) = "Mobile Plant" Then

            Set objAppointment = oItems.Item(j)
            With objAppointment
                If .Subject = "WBC - Send licence - " + ws.Cells(i, 4).Value + " " + ws.Cells(i, 12).Value Then
                    objAppointment.MeetingStatus = olMeetingCanceled
                             .Recipients.Add Sheets("Email List").Range("C3")
                             .Recipients.Add Sheets("Email List").Range("C4")
                             .Recipients.Add Sheets("Email List").Range("C5")
                             .Recipients.Add Sheets("Email List").Range("C6")
                             .Recipients.Add Sheets("Email List").Range("C7")
                             .Recipients.Add Sheets("Email List").Range("C8")
                    objAppointment.Save
                    objAppointment.Send
                End If
            End With
        End If

        If Cells(i, 6).Value <> "" And Cells(i, 5) = "Section 50" Then

            Set objAppointment = oItems.Item(j)
            With objAppointment
                If .Subject = "WBC - Send licence - " + ws.Cells(i, 4).Value + " " + ws.Cells(i, 12).Value Then
                    objAppointment.MeetingStatus = olMeetingCanceled
                             .Recipients.Add Sheets("Email List").Range("C3")
                             .Recipients.Add Sheets("Email List").Range("C4")
                             .Recipients.Add Sheets("Email List").Range("C5")
                             .Recipients.Add Sheets("Email List").Range("C6")
                             .Recipients.Add Sheets("Email List").Range("C7")
                             .Recipients.Add Sheets("Email List").Range("C8")
                    objAppointment.Save
                    objAppointment.Send
                End If
            End With
        End If

        If Cells(i, 6).Value <> "" And Cells(i, 5) = "Section 50 Extension" Then

            Set objAppointment = oItems.Item(j)
            With objAppointment
                If .Subject = "WBC - Send licence - " + ws.Cells(i, 4).Value + " " + ws.Cells(i, 12).Value Then
                    objAppointment.MeetingStatus = olMeetingCanceled
                             .Recipients.Add Sheets("Email List").Range("C3")
                             .Recipients.Add Sheets("Email List").Range("C4")
                             .Recipients.Add Sheets("Email List").Range("C5")
                             .Recipients.Add Sheets("Email List").Range("C6")
                             .Recipients.Add Sheets("Email List").Range("C7")
                             .Recipients.Add Sheets("Email List").Range("C8")
                    objAppointment.Save
                    objAppointment.Send
                End If
            End With
        End If   

        If Cells(i, 6).Value <> "" And Cells(i, 5) = "Non Excavation Permit" Then

            Set objAppointment = oItems.Item(j)
            With objAppointment
                If .Subject = "LBRuT - Send licence - " + ws.Cells(i, 4).Value + " " + ws.Cells(i, 12).Value Then
                    objAppointment.MeetingStatus = olMeetingCanceled
                             .Recipients.Add Sheets("Email List").Range("C3")
                             .Recipients.Add Sheets("Email List").Range("C4")
                             .Recipients.Add Sheets("Email List").Range("C5")
                             .Recipients.Add Sheets("Email List").Range("C6")
                             .Recipients.Add Sheets("Email List").Range("C7")
                             .Recipients.Add Sheets("Email List").Range("C8")
                    objAppointment.Save
                    objAppointment.Send
                End If
            End With
        End If

        If Cells(i, 6).Value <> "" And Cells(i, 5) = "Non Excavation Extension" Then

            Set objAppointment = oItems.Item(j)
            With objAppointment
                If .Subject = "WBC - Send licence - " + ws.Cells(i, 4).Value + " " + ws.Cells(i, 12).Value Then
                    objAppointment.MeetingStatus = olMeetingCanceled
                             .Recipients.Add Sheets("Email List").Range("C3")
                             .Recipients.Add Sheets("Email List").Range("C4")
                             .Recipients.Add Sheets("Email List").Range("C5")
                             .Recipients.Add Sheets("Email List").Range("C6")
                             .Recipients.Add Sheets("Email List").Range("C7")
                             .Recipients.Add Sheets("Email List").Range("C8")
                    objAppointment.Save
                    objAppointment.Send
                End If
            End With
        End If

    Next j
Next i
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...