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。