vba - Excel VBA 创建错误

Question

我正在尝试编写一个宏来读取电子表格。每当有人在一年或更晚的时间内完成一项任务时，它就会向他们的主管发送电子邮件。

我想出了如何每人向主管发送一封电子邮件，但我想知道我是否可以扫描所有人并将他们添加到一封电子邮件中。我试着修改了一下，还是搞不定(这是我VBA的第二天，呵呵)

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "E").Value) = "yes" _
       And LCase(Cells(cell.Row, "H").Value) <> "send" Then

        Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next
        With OutMail
            .To = cell.Value
            .Subject = "Reminder"
            If Cells(cell.Row, "E").Value = "YES" Then
                .body = Cells(cell.Row, "B") & " " & Cells(cell.Row, "A")
                .Send

                On Error GoTo 0
                Cells(cell.Row, "H").Value = "send"
                Set OutMail = Nothing

    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Answer 1

这是未经测试的，但请告诉我它是如何工作的:

Sub test()
Dim OutApp        As Object
Dim OutMail       As Object
Dim cell          As Range
Dim bodyText      As String  'this is new

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

bodyText = ""

On Error GoTo cleanup
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And LCase(Cells(cell.row, "E").Value) = "yes" And LCase(Cells(cell.row, "H").Value) <> "send" Then
        Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next

        With OutMail
            .To = cell.Value
            .Subject = "Reminder"
            If Cells(cell.row, "E").Value = "YES" Then
                'The next line should add the text, and a new line character, so the next cell that needs this will simply be added to the string
                bodyText = Cells(cell.row, "B") & " " & Cells(cell.row, "A") & vbCrLf
            End If
        End With

        On Error GoTo 0
        Cells(cell.row, "H").Value = "send"
        Set OutMail = Nothing
    End If
Next cell

OutMail.body = bodyText
OutMail.Send

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub