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