Excel代码问题的Outlook提醒

我运行以下代码在Outlook中创建提醒

' requires a reference to the Microsoft Outlook          x.0 Object Library
Sub RegisterAppointmentList()
' adds a list of appontments to the Calendar in          Outlook
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim r As Long
DeleteTestAppointments ' deletes previous test appointments
On Error Resume Next
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp =   CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
    MsgBox "Outlook is not available!"
    Exit Sub
End If
End If
r = 5 ' first row with appointment data in the active worksheet
While Len(Cells(r, 5).Formula) > 0
Set olAppItem =     olApp.CreateItem(olAppointmentItem) ' creates a    new appointment
With olAppItem
    ' set default appointment values
    On Error Resume Next
    .Start = Cells(r, 9).Value
    .End = Cells(r, 9)
    .Subject = Cells(r, 2).Value + Cells(r,        3).Value
    .Location = Cells(r, 5).Value
    .Body = Cells(r, 9).Value
    .ReminderSet = True
    .ReminderMinutesBeforeStart = 20160
    .Categories = "TestAppointment" ' add    this to be able to delete the testappointments
    On Error GoTo 0
    .Save ' saves the new appointment to the default folder
End With
r = r + 1
Wend
Set olAppItem = Nothing
Set olApp = Nothing
End Sub

Sub DeleteTestAppointments()
' deletes all testappointments in Outlook
Dim olApp As Outlook.Application
Dim OLF As Outlook.MAPIFolder
Dim r As Long, dCount As Long
On Error Resume Next
Set olApp = GetObject("",     "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = GetObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
    MsgBox "Outlook is not available!"
    Exit Sub
End If
End If
Set OLF =    olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
dCount = 0
For r = OLF.Items.Count To 1 Step -1
If TypeName(OLF.Items(r)) = "AppointmentItem" Then
    If InStr(1, OLF.Items(r).Categories, "TestAppointment", vbTextCompare) = 1 Then
        OLF.Items(r).Delete
        dCount = dCount + 1
    End If
End If
Next r
Set olApp = Nothing
Set OLF = Nothing
End Sub

然而，我有一些异常

它并不总是将“主题”设置为相关行的第2列和第3列中所写的内容。它只是在提醒中返回一个空白

如果L列显示“隔离”或“检查”，我希望它不会创建提醒。 任何帮助都将不胜感激

这里是excel工作簿的链接（很高兴您能使用它：）

对于下一个请求，请在此条件之间嵌入代码

While Len(Cells(r, 5).Formula) > 0
    Select Case LCase(Cells(r, 12).Value)
        Case "quarantined", "inspected"
        Case Else
            '
            '~~> Your code to create an appointment
            '
    End Select
Wend

---

如果在此

单元格（r，2）.值+单元格（r，3）.值中使用
&
而不是
+
，那么会发生什么？它做的事情完全相同。已完成大多数项目的主题，但仍留下一些空白。不确定发生了什么，但使用&s再次尝试，它现在正在工作！！！！如果L列显示隔离或检查，如何使其不产生提醒？谢谢您的帮助。有一件事我不明白，上面的代码检查列L中的值是
隔离的
还是
检查的
。如果您使用的是“True”，那么您必须适当地修改代码。