Dee_EFF

Option Explicit

'************************************************
'*                                              *
'* AutoEmail Function for Excel for Freelancers *
'* Author: David Houston                        *
'* Date: 16.05.2024                             *
'*                                              *
'************************************************

Const FromEmail As String = "whateveremail@email.com"       ' Set the From email address
Const ccEmail As String = "whateveremail@email.com"         ' Set the CC email address



Sub AutoEMail()

Dim OutlookApp As Outlook.Application
Dim OutlookMail As MailItem
Dim Outlook
Dim CustEmailRange As Range
Dim Cell As Range
Dim oSubject As String

' Set up a holder for the subject line, only "No AP Listed" will change
oSubject = Sheet1.Cells(Cell.Row, 46).Value & " (" & Sheet1.Cells(Cell.Row, 3).Value & " / No AP Listed )"

Set OutlookApp = New Outlook.Application                    ' Create new instance of Outlook
Set CustEmailRange = Sheet1.Range("A1:A100")                ' Define the range containing the customer email details.

For Each Cell In CustEmailRange                             ' Loop over the customer email range

    Set OutlookMail = OutlookApp.CreateItem(olMailItem)         ' Create a New Email

        ' If column 36 has a value, replace "No AP Listed" in the subject line
        If Sheet1.Cells(Cell.Row, 36).Value <> "" Then
            oSubject = Replace(oSubject, "No AP Listed", Sheet1.Cells(Cell.Row, 36).Value)
        End If

        With OutlookMail
            .To = Cell.Value                                        ' Set the To address
            .SentOnBehalfOfName = FromEmail                         ' Set the From Address
            .CC = ccEmail                                           ' Set the CC address
            .Subject = oSubject                                     ' Set the Subject
            .Body = EmailBody                                       ' Set the body from function
            .Display                                                ' Display the completed email, change to .Send if desired
        End With

    Set OutlookMail = Nothing                                   ' Unset the mail item, not necessary

Next Cell

Set OutlookApp = Nothing                                    ' Unset Outlook

End Sub

Function EmailBody()
EmailBody = Sheets("InitialEmailBody").Range("EmailBody").Value & vbCrLf
EmailBody = EmailBody & "Review ID: " & Sheet1.Cells(Cell.Row, 3).Value & vbCrLf
EmailBody = EmailBody & "ReviewOrder: " & IIf(Sheet1.Cells(Cell.Row, 4).Value = "", "Not Listed", Sheet1.Cells(Cell.Row, 4).Value) & vbCrLf
EmailBody = EmailBody & "Review Plan: " & IIf(Sheet1.Cells(Cell.Row, 36).Value = "", "Not Listed", Sheet1.Cells(Cell.Row, 36).Value) & vbCrLf
EmailBody = EmailBody & "Review Name: " & Sheet1.Cells(Cell.Row & Range("TEST").Value) & vbCrLf
EmailBody = EmailBody & "Review Description: " & Sheet1.Cells(Cell.Row, 9).Value & vbCrLf
EmailBody = EmailBody & "Link: " & Sheet1.Cells(Cell.Row, 42).Value & vbCrLf
End Function