Checking a string value to return a range from another worksheet then add to .To line in email

user_17958690 0
Viewed 56

I am trying to get email addresses from a worksheet(Sheet1) into the .To line for an outlook email based on the specific string value in the main worksheet.

I have managed to play with it several ways but none have given the results I need. The idea is that it checks a cell on the main worksheet for a specific string value, then would reference a specific range of cells in one column from another worksheet based on the string value and include these emails in the .To line, separated by a";".

I also noticed it removed data from the cells when it pulled it in testing, replacing some cells with "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
outlook vba excel email string
1 Answers

First of all, creating a new Outlook Application instance in the Worksheet_BeforeDoubleClick handler is not really a good idea. Consider creating an Outlook instance once and then only create a new email in the event handler instead.

Instead of relying on To or CC properties:

Set OutMail = OutApp.CreateItem(0)
With OutMail
   .To = sTo
   .CC = "REQ@EMAIL.COM"
   .Subject = ""
   .HTMLBody = "Please attend "
   .Display
End With

I'd recommend using the Recipients property of the MailItem class which returns a Recipients collection that represents all the recipients for the Outlook item. For example:

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

Then I'd recommend using the Resolve or ResolveAll method which attempts to resolve all the Recipient objects in the Recipients collection against the Address Book.

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

You may find the How To: Fill TO,CC and BCC fields in Outlook programmatically article helpful.

user_16033510
Related