У меня есть следующий код для поиска встреч в календаре 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