Untitled

Public Sub SubCreateEmailBasedonList()
    Dim lngX As Long
    Dim strFilePath As String
    Dim strCC As String ' Combine CC and BCC recipients
    lngX = 2
    Do While shtMain.Cells(lngX, 1) <> vbNullString
        strFilePath = ThisWorkbook.Path & "\Output\" & shtMain.Cells(lngX, 1) & " Leader Settlement Option Letter.pdf"
        ' Concatenate CC and BCC recipients
        strCC = shtMain.Cells(lngX, 14) & ";" & shtMain.Cells(lngX, 15)
        CreateEmailOutContract shtMain.Cells(lngX, 13), strCC, shtMain.Cells(lngX, 1), strFilePath ' Use only CC for both CC and BCC
        lngX = lngX + 1
    Loop
End Sub

Private Sub CreateEmailOutContract(ByVal strTO As String, ByVal strCC As String, ByVal strName As String, ByVal sFile As String)
    Dim objOutlook As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim Signature As String
    Dim sBody As String
    '''
    Set objOutlook = New Outlook.Application
    Set objMail = objOutlook.CreateItem(0)
    objMail.Display
    Signature = objMail.HTMLBody
    With objMail
        'Debug.Print sFile
            .Attachments.Add sFile
            '.Body = ""
            sBody = "<HTML><BODY><P>Dear <B>" & strName & ",</B></P>" & _
            "<P>As part of the process related to your DOU clawback, we are sending you a letter outlining the details.  Please take the time to review the letter thoroughly and provide and feedback within the specified timeframe.<br><br>Thank you for your cooperation.</P>" & _
            "</BODY></HTML>"
        .subject = "Leader Settlement Option " & strName
        .To = strTO
        .CC = strCC ' Use strCC for both CC and BCC
        '.SentOnBehalfOfName = "distributionsupport.ph@fwd.com"
        .HTMLBody = sBody & vbNewLine & Signature
        .Save
    End With
    Set objOutlook = Nothing
    Set objMail = Nothing
    ThisWorkbook.Activate
End Sub
Editor is loading...