VBA分配Outlook任务问题：代码仅运行一次，需循环至空白行

你的代码只执行一次就停止，核心问题是循环结构混乱，同时Outlook对象的创建位置不合理，具体问题点：

• 外层Do Until循环未初始化i，且在循环内强行把i设为2，导致逻辑冲突
• 嵌套了不必要的内层Do Until，反而打断了遍历流程
• Outlook应用对象被放在循环内重复创建，既低效又容易引发异常

下面是修复后的代码：

Sub tasksV1()
    Dim OutApp As Outlook.Application
    Dim OutTask As Outlook.TaskItem
    Dim myRecipient As Outlook.Recipient
    Dim i As Integer
    
    ' 初始化Outlook应用对象（只创建一次）
    Set OutApp = CreateObject("Outlook.Application")
    
    ' 从第2行开始遍历（假设第1行是表头）
    i = 2
    Do Until Cells(i, 1) = ""
        ' 为每一行创建新的任务项
        Set OutTask = OutApp.CreateItem(olTaskItem)
        
        ' 添加并解析收件人
        Set myRecipient = OutTask.Recipients.Add(Cells(i, "H"))
        myRecipient.Resolve
        
        If myRecipient.Resolved Then
            With OutTask
                .Subject = Cells(i, "C")
                .StartDate = Cells(i, "E")
                .DueDate = Cells(i, "E") + 2
                .ReminderTime = .DueDate - 1
                .Body = "Please mark the task as completed once the document is updated with the document mentioned in subject."
                .Assign
                .Display ' 如果不需要弹窗显示，可改成 .Save 直接保存任务
            End With
        End If
        
        ' 释放当前任务对象
        Set OutTask = Nothing
        ' 移到下一行
        i = i + 1
    Loop
    
    ' 释放Outlook应用对象
    Set OutApp = Nothing
End Sub

关键修改说明： #

• 把OutApp的创建移到循环外，避免重复初始化Outlook实例
• 初始化i = 2在循环开始前，确保从指定行开始遍历
• 移除了嵌套的内层循环，用单一Do Until遍历所有非空行
• 每次循环创建新的OutTask对象，保证每行对应一个独立任务
• 添加了对象释放的逻辑，避免内存泄漏

如果不需要每次创建任务时弹出窗口，把.Display改成.Save即可直接将任务保存到Outlook中。

内容的提问来源于stack exchange，提问作者Gotham's kid