检查字符串值以返回另一个工作表中的范围，然后添加到电子邮件中的.to行

Question

我试图将电子邮件地址从工作表(Sheet1)中获取到基于主工作表中特定字符串值的outlook电子邮件的。to行。

我已经设法用几种方法来玩，但没有一种方法能得到我需要的结果。其想法是，它检查主工作表上的单元格是否有特定的字符串值，然后根据字符串值从另一个工作表中引用一列中的特定单元格范围，并将这些电子邮件包含在。to行中，以";"分隔。

我还注意到它在测试中从单元格中删除了数据，用"Column1">

替换了一些单元格

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim emailRng As Range, cl As Range
Dim sTo As String
Set emailRng = Worksheets("SHEET1").Range("D3:D20")

For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next

sTo = Mid(sTo, 2)

If InStr(ActiveCell.Value, "ABC") > 0 Then
emailRng = ThisWorkbook.Sheets("SHEET1").Range("D3:D5")

ElseIf InStr(ActiveCell.Value, "XYZ") > 0 Then
emailRng = ThisWorkbook.Sheets("SHEET1").Range("D11:D15")

End If
If Target.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Select Case Target.Column
Case Is = 15
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sTo
.CC = "[e-mail]"
.Subject = ""
.HTMLBody = "Please attend "
.Display
End With
End Select
Application.ScreenUpdating = False
End Sub

Answer 1

首先，在Worksheet_BeforeDoubleClick处理程序中创建一个新的Outlook Application实例并不是一个好主意。考虑创建一次Outlook实例，然后在事件处理程序中只创建一个新电子邮件。

不依赖To或CC属性:

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sTo
.CC = "[e-mail]"
.Subject = ""
.HTMLBody = "Please attend "
.Display
End With

我建议使用MailItem类的收件人属性，它返回一个代表Outlook项目的所有收件人的Recipients集合。例如:

Sub CreateStatusReportToBoss() 
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient 

Set myItem = Application.CreateItem(olMailItem) 
Set myRecipient = myItem.Recipients.Add("Eugene Astafiev") 
myItem.Subject = "Status Report" 
myItem.Display 
End Sub

然后我建议使用Resolve或ResolveAll方法，它试图解析Recipients集合中针对地址簿的所有Recipient对象。

Sub CheckRecipients() 
Dim MyItem As Outlook.MailItem 
Dim myRecipients As Outlook.Recipients 
Dim myRecipient As Outlook.Recipient 

Set myItem = Application.CreateItem(olMailItem) 
Set myRecipients = myItem.Recipients 
myRecipients.Add("Eugene Astafiev") 
myRecipients.Add("Dmitry Anafriev") 
myRecipients.Add("Tom Wilon") 
If Not myRecipients.ResolveAll Then 
For Each myRecipient In myRecipients 
If Not myRecipient.Resolved Then 
MsgBox myRecipient.Name 
End If 
Next 
End If 
End Sub

您可能会发现如何:在Outlook中以编程方式填写收件人，抄送和密件抄送字段的文章很有帮助。