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的建議更新了代碼。