Удалить встречу Outlook, если ячейка содержит определенный текст - PullRequest
Новая
       9

Удалить встречу Outlook, если ячейка содержит определенный текст

0 голосов
/ 11 апреля 2019

В настоящее время у меня настроен код для добавления встречи в Outlook, если в ячейке Excel содержится слово «Нет».То, что я хотел бы сделать, это удалить существующую встречу, если эта же ячейка будет изменена на «Н / Д».Я попытался адаптировать некоторый код, который я нашел в другом месте для этого, но не могу заставить его работать, в настоящее время он отображает «Ошибка компиляции: дальше без» для 

Sub DeleteCalendarItems()

Dim r As Long, i As Long, 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
Dim strSubject      As String

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("Section 74")


r = ws.Cells(Rows.Count, 1).End(xlUp).Row 'Rows.Count should also have a reference to a wb & ws
For i = 2 To r

    If ws.Cells(i, 9) = "N/A" Then
                ws.Cells(i, 13) = "Yes"
        Set objAppointment = oItems.Item(i)
        With objAppointment
            If .Subject = strSubject Then
                objAppointment.Delete
            End If
        End With
    End If
Next i
End Sub

Ответы [ 2 ]

0 голосов
/ 11 апреля 2019

Мне удалось как-то разобраться - мне нужно было добавить вложенный For цикл 

Sub DeleteNASec74()

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("Section 74")


r = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To r
For j = oItems.Count To 1 Step -1
    If ws.Cells(i, 9).Value = "N/A" Then
    ws.Cells(i, 13) = "Yes"
        Set objAppointment = oItems.Item(j)
        With objAppointment
            If .Subject = "Send reminder email - " + ws.Cells(i, 2).Value Then
                objAppointment.Delete
            End If
        End With
    End If
Next j
Next i
End Sub
0 голосов
/ 11 апреля 2019

A With, If и For оператор (и более) всегда должен быть закрыт 

Sub DeleteCalendarItems()
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
Dim strSubject      As String

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("Section 74")


r = ES.Cells(Rows.Count, 1).End(xlUp).Row 'Rows.Count should also have a reference to a wb & ws
For i = 2 To r

    If ES.Cells(i, 9).Value = "N/A" Then
        Set objAppointment = oItems.Item(i)
        With objAppointment
            If .Subject = strSubject Then
                objAppointment.Delete
            End If
        End With
    End If
Next i
End Sub
...