Excel VBA – 发送Outlook电子邮件

在单元格AI有名字，例如约翰·史密斯
在Cell BI中有一个标准 – 到期/未到期。
我需要以某种方式修改下面的代码来执行以下操作：
从单元格A生成电子邮件，格式为[e-mail]，然后发送提醒电子邮件，但只发送到一封电子邮件中的唯一电子邮件。 到目前为止，这是我的：

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 

不幸的是，我不能进一步得到。 任何人都可以帮我吗？

Answer 1

全范围的答案在这里。 我在我添加/编辑的现有代码的区域发表评论。

 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 

Answer 2

 LCase(Cells(cell.Row, "B").Value) = "Due" 

这将始终返回false，因为LCase()将整个string转换为Lower 大小写 ，并将其与"Due"大写"D"

要么将您的比较string更改为"due" ：

 LCase(Cells(cell.Row, "B").Value) = "due" 

或（不build议，但为了教育目的显示）将您的string操作更改为适当的情况：

 StrConv(Cells(cell.Row, "B").Value, vbProperCase) = "Due" 

Answer 3

也许这样？

 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 

我所做的是：将mailitem创build到循环中，并在显示邮件后重置variablesEmailAddr

另外，我用Macro Man更新了代码他的build议。