VBA send email to 3 addresses in 3 different cells

[floggingmolly]

I have a code that sends an email with attachment. Each attachment needs to go to 3 different addresses which are in 3 different cells. I can get it to send to the address in column K, but I need it to also send to L and M. Here is the code I have so far. I'm not sure how to add multiple cells in the .To line. Any help would be greatly appreciated.

.Range("p" & CustRow).Value = TemplName 'Template Name
                                   .Range("q" & CustRow).Value = Now
                                    If .Range("R3").Value = "Email" Then
                                                  Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application
                                                  Set OutMail = OutApp.CreateItem(0) 'Create Email
                                                  With OutMail
                                                      .To = Sheet1.Range("K" & CustRow).Value
                                                      .Subject = "Hi, " & Sheet1.Range("F" & CustRow).Value & " We Miss You"
                                                      .Body = "Hello, " & Sheet1.Range("F" & CustRow).Value & " Its been a while since we have seen you so we wanted to send you a special letter. Please see the attached file"
                                                      .Attachments.Add FileName
                                                      .Display 'To send without Displaying change .Display to .Send

 

[sykes]

Not tested, but couldn't you just concatenate the 3 cells' contents, and separate with a semicolon?

.Range("p" & CustRow).Value = TemplName 'Template Name
                                   .Range("q" & CustRow).Value = Now
                                    If .Range("R3").Value = "Email" Then
                                                  Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application
                                                  Set OutMail = OutApp.CreateItem(0) 'Create Email
                                                  With OutMail
                                                      .To = Sheet1.Range("K" & CustRow).Value & ";" & Sheet1.Range("L" & CustRow).Value & ";" Sheet1.Range("M" & CustRow).Value
                                                      .Subject = "Hi, " & Sheet1.Range("F" & CustRow).Value & " We Miss You"
                                                      .Body = "Hello, " & Sheet1.Range("F" & CustRow).Value & " Its been a while since we have seen you so we wanted to send you a special letter. Please see the attached file"
                                                      .Attachments.Add FileName
                                                      .Display 'To send without Displaying change .Display to .Send

You could clean it up a bit, but it should steer you in the right direction...

 

[DanteAmor]

Hi @sykes, It works, but missed a &

.To = Sheet1.Range("K" & CustRow).Value & ";" & Sheet1.Range("L" & CustRow).Value & ";" & Sheet1.Range("M" & CustRow).Value

Hi @floggingmolly, another option, You can increase more cells, just change the M to another column.

  .To = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Sheet1.Range("K" & CustRow & ":[B][COLOR=#0000ff]M[/COLOR][/B]" & CustRow).Value)), ";")