Excel VBA - 發送Outlook電子郵件

在單元格A中，我有名稱，例如，約翰史密斯
在細胞B我有一個標準 - 到期/未到期。
我需要以某種方式修改下面的代碼執行以下操作：
生成從小區A郵件，格式[email protected] 然後發送了電子郵件提醒，但只有唯一的電子郵件在一個電子郵件。到目前爲止，這是我：Excel VBA - 發送Outlook電子郵件

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

我無法得到更進一步，很遺憾。任何人都可以幫助我嗎？

來源

2016-01-21 warfo09

除了@MacroMan引發的問題，你的代碼看起來不錯。究竟是什麼問題。你沒有說明你的**沒有工作。 –

在A列中，我有一個姓名和姓氏列表，我不知道如何將循環（即John Smith轉換爲[email protected]）併發送到一封電子郵件中。此外，我以某種方式需要過濾掉併發送給唯一的電子郵件，有時人重複... – warfo09

是每個公司的名稱相同嗎？或者是在另一個單元格或其他地方定義的？ –

全範圍的答案在這裏。我在我添加/編輯的現有代碼的各個方面發表了評論。

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

來源

2016-01-21 14:28:59

謝謝，它對你有用嗎？我的Outlook電子郵件附帶空的「收件人：」字段使用此方法.... – warfo09

好吧，我發現這個問題。如果cell.Value像「* @ *」和_ 這不適用了。 – warfo09

對不起，我遇到了您的方法問題...出於某種原因，我仍然收到重複的電子郵件...？ – warfo09

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"

來源

2016-01-21 14:05:44

謝謝，無論如何，我可以轉換「約翰史密斯」爲「[email protected]」EmailAddr在單元格A？ – warfo09

'emailAdd = LCase $（替換（cell.value，「」，「。」）和「@ 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 = 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。

來源

2016-01-21 14:13:14 Michael

Excel VBA - 發送Outlook電子郵件

回答

相關問題