Excel VBA-发送前景电子邮件

Question

在Cell AI中有名字，例如John Smith
在单元格BI中有一个条件-到期/不到期。
我需要以某种方式修改以下代码以执行以下操作：
从单元格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

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

这将始终返回false，因为LCase()整个字符串转换为L奥尔情况下 ，你要比较它"Due"它有一个大写字母"D"

将您的比较字符串更改为"due" ：

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

或者（不推荐，但出于教学目的显示）将字符串操作更改为适当的大小写：

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

Answer 2

这里有完整的答案。 我在添加/编辑的现有代码的区域中添加了注释。

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 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。

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