简体   繁体   中英

Excel VBA Creation error

I am attempting to write a macro to read a spreadsheet. Whenever someone is one year or later with a task, it will send their supervisor email.

I figured out how to send one email per person to a supervisor, but I wonder if I can scan all people and add them to one email. I tried to modify it, but I could not get it (this is my second day of VBA, hehe)

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

This is untested, but let me know how it works:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM