send email to 2 different email accounts

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
667
Office Version
  1. 365
Platform
  1. Windows
hello ,

i use the following email template :-

Code:
Option Explicit

Sub PC_Email()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MailAttachments As String
    Dim cell As Variant '                             Not previously DIM'd
    
    Sheets("Sheet1").Select '                         Edit as required
    Range("A1").Select
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
  
   On Error GoTo cleanup
    If WorksheetFunction.CountA(Range("K2:K100")) = 0 Then
        MsgBox "To send email, please enter an X in Column K.", vbCritical, "Missing Entry"
        Exit Sub
    End If
    For Each cell In Columns("C").Cells
        If cell.Value Like "?*@?*.?*" And _
        LCase(Cells(cell.Row, "K").Value) <> "" Then
    
    Set OutMail = OutApp.CreateItem(0)
        
            On Error Resume Next
                              
            With OutMail
            
              strbody = "Please Delete Any Previous Emails Related To This Period" & vbNewLine & vbNewLine & _
                         "Good Morning, " & vbNewLine & vbNewLine & _
                        "Please find attached applicable time sheet / expense's / receipts for WC: " & Cells(cell.Row, "A") & vbNewLine & vbNewLine & _
                        " " & Cells(cell.Row, "F") & " timesheet to be paid " & Cells(cell.Row, "G") & vbNewLine & vbNewLine & _
                        "KR" & vbNewLine & vbNewLine & _
                        "me" & vbNewLine & vbNewLine & _
                        "you" & vbNewLine & vbNewLine & _
                        "12344678"
              
                .To = Cells(cell.Row, "C").Value
                .CC = Cells(cell.Row, "D").Value
                .BCC = Cells(cell.Row, "E").Value
                .Subject = "Timesheet & Expenses Claim For WC " & Cells(cell.Row, "A").Value
                .Body = strbody
               
                '.Attachments.Add Application.ActiveWorkbook.FullName
                .Attachments.Add ActiveSheet.Cells(cell.Row, "H").Value
                .Attachments.Add ActiveSheet.Cells(cell.Row, "I").Value
                .Attachments.Add ActiveSheet.Cells(cell.Row, "J").Value
                
                .Display  'Or use .Send
                  
                
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell




cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    
End Sub

However, i want it to prompt a 'choice' so i can use another email template ( its just few different amendments from the above code) which I can sort after some canny person can sort out the y/n option 1st?

MTIA
Trevor3007
 
Last edited by a moderator:

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Forum statistics

Threads
1,213,497
Messages
6,113,998
Members
448,539
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top