如果单元格包含特定文本，则删除Outlook约会

Sub DeleteOutlookAppointment()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItems As Object
    Dim olAppt As Object
    Dim rng As Range
    Dim cell As Range
    Dim searchText As String
    
    ' 设置要搜索的文本
    searchText = "特定文本"
    
    ' 创建Outlook应用程序对象
    Set olApp = CreateObject("Outlook.Application")
    ' 获取Outlook命名空间
    Set olNamespace = olApp.GetNamespace("MAPI")
    ' 获取默认日历文件夹
    Set olFolder = olNamespace.GetDefaultFolder(9) ' 9表示日历文件夹
    
    ' 获取日历文件夹中的所有约会
    Set olItems = olFolder.Items
    
    ' 遍历Excel中的所有单元格，查找包含特定文本的单元格
    For Each rng In ActiveSheet.UsedRange
        For Each cell In rng
            ' 如果单元格包含特定文本，则删除对应的Outlook约会
            If InStr(1, cell.Value, searchText, vbTextCompare) > 0 Then
                ' 遍历所有约会，查找匹配的约会
                For Each olAppt In olItems
                    If olAppt.Subject = cell.Value Then
                        olAppt.Delete ' 删除约会
                        Exit For
                    End If
                Next olAppt
            End If
        Next cell
    Next rng
    
    ' 释放对象
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
    MsgBox "已删除包含特定文本的Outlook约会。"
End Sub