mail@pastecode.io avatar
a month ago
1.9 kB
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
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)
    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>" & _
        .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
    End With
    Set objOutlook = Nothing
    Set objMail = Nothing
End Sub
Leave a Comment