Excel VBA - 发送Outlook电子邮件

Question

在单元格A中，我有名称，例如，约翰史密斯
在细胞B我有一个标准 - 到期/未到期。
我需要以某种方式修改下面的代码执行以下操作：
生成从小区A邮件，格式john.smith@company.com 然后发送了电子邮件提醒，但只有唯一的电子邮件在一个电子邮件。 到目前为止，这是我：

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()整个字符串转换为大号奥尔情况下和你比较它"Due"它有一个大写"D"

要么，改变你的比较字符串"due"：

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

或者（不REC ommended，但是示出了教育的目的）您的字符串操作更改为正确的大小写：

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进入循环的建立，并显示邮件后

另外，我更新了宏满他的建议代码重置变量EMAILADDR。