In Cell AI have names, eg John Smith
In Cell BI have a criteria - Due/ Not Due.
I need to somehow modify the below code to do the following:
Generate emails from cell A, in the format john.smith@company.com and Then send out a reminder email, but only to unique emails in one email. So far this is what I have:
Sub SendEmail()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
'Create Outlook object
Set OutlookApp = New Outlook.Application
'Loop through the rows
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" And _
LCase(Cells(cell.Row, "B").Value) = "Due" _
Then
EmailAddr = EmailAddr & ";" & cell.Value
End If
Next
Msg = "Please review the following message."
Subj = "This is the Subject Field"
'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Msg
.Display
End With
End Sub
I can't get much further, unfortunately. Can anyone help me please?
LCase(Cells(cell.Row, "B").Value) = "Due"
This will always return false, because LCase()
converts the whole string to L ower case and you're comparing it to "Due"
which has an upper case "D"
Either, change your comparison string to "due"
:
LCase(Cells(cell.Row, "B").Value) = "due"
Or (not recommended, but showing for education purpose) change your string operation to proper case:
StrConv(Cells(cell.Row, "B").Value, vbProperCase) = "Due"
Fully scoped answer here. I put comments in the areas of the existing code that I added / edited.
Sub SendEmail()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
'Create Outlook object
Set OutlookApp = New Outlook.Application
'Loop through the rows
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" And _
LCase(Cells(cell.Row, "B").Value) = "due" Then
'first build email address
EmailAddr = LCase$(Replace(cell.Value, " ", ".")) & "@company.com"
'then check if it is in Recipient List build, if not, add it, otherwise ignore
If InStr(1, Recipient, EmailAddr) = 0 Then Recipient = Recipient & ";" & EmailAddr
End If
Next
Recipient = Mid(Recipient, 2) 'get rid of leaing ";"
Msg = "Please review the following message."
Subj = "This is the Subject Field"
'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = Recipient 'full recipient list
.Subject = Subj
.Body = Msg
.Display
End With
End Sub
Maybe like this?
Sub SendEmail()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
'Create Outlook object
Set OutlookApp = New Outlook.Application
'Loop through the rows
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" And _
LCase(Cells(cell.Row, "B").Value) = "due" _
Then
EmailAddr = cell.Value
End If
Msg = "Please review the following message."
Subj = "This is the Subject Field"
'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Msg
.Display
End With
EmailAddr = ""
Next
End Sub
What I did was: Include the creation of the mailitem into the loop, and reset the variable EmailAddr after the mail is displayed
Also, I updated the code with Macro Man his suggestion.
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.