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.