Cacher is the code snippet organizer for pro developers

Public Sub WriteTaskToOutlook()
    '生成艾斯浩宾的记忆类任务
    Dim Task As Outlook.TaskItem
    Dim rng As Range
    Dim i As Long
    For i = 3 To 8 Step 1
        If Range("B" & i).Value <> "" Then
            Set Task = Outlook.Application.CreateItem(olTaskItem)
            Task.Subject = "初记：" & Range("B" & i).Value & "-" & Range("C" & i).Value
            Task.StartDate = Range("A" & i).Value
            Task.DueDate = Range("A" & i).Value
            Task.Save
        End If
        If Range("D" & i).Value <> "" Then
            Set Task = Outlook.Application.CreateItem(olTaskItem)
            Task.Subject = "复习：" & Range("B" & i - 2).Value & "-" & Range("C" & i - 2).Value
            Task.StartDate = Range("A" & i).Value
            Task.DueDate = Range("A" & i).Value
            Task.Save
        End If
        If Range("E" & i).Value <> "" Then
            Set Task = Outlook.Application.CreateItem(olTaskItem)
            Task.Subject = "复习：" & Range("B" & i - 4).Value & "-" & Range("C" & i - 4).Value
            Task.StartDate = Range("A" & i).Value
            Task.DueDate = Range("A" & i).Value
            Task.Save
        End If
    Next
End Sub

Sub add_appointment_1()
    Dim ol As Outlook.Application
    Set ol = CreateObject("Outlook.Application")
    Dim olApt As AppointmentItem
    Dim r
    For r = 2 To Range("b65536").End(xlUp).Row
        Set olApt = ol.CreateItem(olAppointmentItem)
        With olApt
            .Subject = Cells(r, 1) '事件名称
            .Start = Cells(r, 2) '开始时间
            .Duration = 30 '持续时间
            .ReminderSet = False
            .Importance = olImportanceHigh
            .Categories = "wk-1"
            '.ReminderMinutesBeforeStart = 45 '提前N分钟提醒
            .Body = "Excel日程提醒" '事件内容
            .Save '只能保存到默认的名为「日历」的下面
            '.Display
        End With
    Next
    set olApt = Nothing
    Set ol = Nothing
End Sub