检查字符串值以从另一个工作表返回一个范围，然后在电子邮件中添加到.To行
检查字符串值以从另一个工作表返回一个范围，然后在电子邮件中添加到.To行
提问于 2022-05-14 09:27:13
我试图根据主工作表中的特定字符串值，将工作表(Sheet1)中的电子邮件地址输入到.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 = "REQ@EMAIL.COM"
.Subject = ""
.HTMLBody = "Please attend "
.Display
End With
End Select
Application.ScreenUpdating = False
End Sub回答 1
Stack Overflow用户
发布于 2022-05-14 20:56:51
首先，在Worksheet_BeforeDoubleClick处理程序中创建一个新的Outlook实例并不是一个好主意。考虑创建一次Outlook实例，然后只在事件处理程序中创建新的电子邮件。
而不是依赖于或CC属性：
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sTo
.CC = "REQ@EMAIL.COM"
.Subject = ""
.HTMLBody = "Please attend "
.Display
End With我建议使用MailItem类的MailItem属性，该属性返回一个Recipients集合，该集合表示Outlook项的所有收件人。例如：
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中的TO、CC和BCC字段的文章很有帮助。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/72238905
复制相关文章
相似问题
腾讯云开发者
