Adding a custom message.

[Elliottj2121]

Hello everyone!

I have some code that I hobbled together with the help of many of the experts here in which I am very very thankful! This code takes individual invoice data and compiles it in an email to customers that are overdue on their payments. The code works well, but I want to create a custom message (the same to each customer) each week. But I have to manually retype the code each time I want to change it. Is there a way to enter the message in a cell and keep its formatting in the email? The code is also kind of disorganized. Any help would be greatly appreciated!

Sub Make_Inq_Emails_Elliott()
    ProperCNCN
    i45Email
End Sub
Private Sub ProperCNCN()

Dim wsProper As Worksheet
Set wsProper = ActiveWorkbook.Worksheets(1)
Dim lProperLastRow As Long, c As Range, n As Range
Dim CustNameRange As Range, ContNameRange As Range
Dim lCustNameRange As String, lContNameRange As String
lProperLastRow = ProperLastRow(wsProper)
    Set CustNameRange = Range("B2:B" & lProperLastRow)
    Set ContNameRange = Range("H2:H" & lProperLastRow)

    For Each c In CustNameRange
        c.Value = Application.WorksheetFunction.Proper(c.Value)
    Next c
    
    For Each n In ContNameRange
        n.Value = Application.WorksheetFunction.Proper(n.Value)
    Next n

Columns("I:S").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns(8).TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
        :=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array( _
        Array(1, 1), Array(2, 9), Array(3, 9), Array(4, 9)), TrailingMinusNumbers:=True
        
Columns("I:S").Delete Shift:=xlToLeft

Cells.Select
    Selection.Columns.AutoFit

End Sub

Private Sub i45Email()

msg1 = Range("L1").Value

 Set rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))
  x = rng.Rows.Count
    tableHdr = "<table border=1 style=border-collapse:collapse><tr><th width=101 style='width:76.1pt;padding:.75pt .75pt .75pt .75pt;background-color:#1C6EA4'><p align=center style='text-align:center'><font color='white'><b>" & Range("C1").Value & "</b></font></th>" _
            & "<th width=101 style='width:76.1pt;padding:.75pt .75pt .75pt .75pt;background-color:#1C6EA4'><p align=center style='text-align:center'><font color='white'><b>" & Range("D1").Value & "</b></font></th>" _
            & "<th width=101 style='width:76.1pt;padding:.75pt .75pt .75pt .75pt;background-color:#1C6EA4'><p align=center style='text-align:center'><font color='white'><b>" & Range("E1").Value & "</b></font></th>" _
            & "<th width=101 style='width:76.1pt;padding:.75pt .75pt .75pt .75pt;background-color:#1C6EA4'><p align=center style='text-align:center'><font color='white'><b>" & Range("F1").Value & "</b></font></th>" _
            & "<th width=101 style='width:76.1pt;padding:.75pt .75pt .75pt .75pt;background-color:#1C6EA4'><p align=center style='text-align:center'><font color='white'><b>" & Range("G1").Value & "</b></font></th>" _

    For Each Cell In rng
    If Cell.Value <> "" Then
    If Not Cell.Offset(0, 1).Value = "yes" Then
    NmeRow = Cell.Row
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Para1 = "I hope you are doing well. I wanted to discuss the current status of the overdue invoices in your account. Our ongoing partnership is of great importance to us, and we understand that unforeseen circumstances can sometimes lead to payment delays. However, it has come to our attention that these invoices have exceeded their due dates, and we have not yet received any payments or received communication regarding their status from your end."

    Para2 = "We kindly request that you provide us with an update on the payment status of these outstanding invoices. Maintaining accurate financial records and ensuring that our accounts are in good standing is crucial for both parties involved. We want to ensure that everything is proceeding as planned."

    Para3 = "If there are any issues or concerns that may be affecting the payment process, please do not hesitate to inform us. We are here to assist you in any way we can."

    Para4 = "Thank you for your attention to this matter, and we look forward to hearing from you soon so that we can properly update our records and ensure the smooth continuation of our business relationship."
    
    MailTo = Cell.Value
    MailSubject = "Request for Payment Update on Past Due Invoices for" & " " & Cell.Offset(0, -7).Value
        
    lName = "Logo4AutoEmail.png"
    lPath = "D:\Users\elliott.jenneman\Pictures\" & lName
    
    Greeting = "<p><span style='font-size:12.0pt;font-family:'Times New Roman',serif'>Hello" & " " & Cell.Offset(0, -1).Value & "," & "</span></p>"
    
    Message = "<p><span style='font-size:12.0pt;font-family:'Times New Roman',serif'>" & Para1 & "</p>" & "<p>" & Para2 & "</p>" & "<p>" & Para3 & "</p>" & "<p>" & Para4 & "</span></p>"
    
    
    RCMSignature = "<p><span style='font-size:12.0pt;font-family:'Times New Roman',serif'>Kind Regards,</span><br><b><i><span style='font-size:10.0pt;font-family:'Georgia',serif;color:#595959'>&nbsp;</span></i></b>" _
                    & "<br><b><i><span style='font-size:10.0pt;font-family:'Georgia',serif;color:#595959'>Credit Manager</span></i></b><b><span style='font-size:10.0pt;font-family:'Georgia',serif;color:#595959'> | </span></b><i><span style='font-family:'Arial Black',sans-serif;color:#0070C0'>Acme Steel Company </span></i><b><span style='font-size:10.0pt;" _
                    & "font-family:'Georgia',serif;color:#0070C0'></span></b><b><span style='font-size:10.0pt;font-family:'Georgia',serif;color:#595959'>| Regional Credit Manager</span></b>" _
                    & "<br><span style='font-size:10.0pt;color:#595959'>123 2<sup>nd</sup> St NE Anytown, CA 90210 | p (651) 555-1234 ext 5252</span><br><span lang=ES-US style='font-size:10.0pt;color:#595959'>john.smith@acmesteel.com</span>" _
                    & "<br><a href='www.mcneilus.com'><b><span style='font-size:10.0pt;font-family:'Cambria',serif;color:#0563C1'>www.mrexcel.com</span></b></a><span style='font-size:10.0pt;color:#1058A8'></span>" _
                    & "<span style='font-size:10.0pt;color:#595959'>| Generaric company motto<o:p></span></p><p>&nbsp;</p>"
    MailBody = "<tr>" _
            & "<td align=center style='text-align:center'>" & Cell.Offset(0, -6).Value & "</td>" _
            & "<td align=center style='text-align:center'>" & Cell.Offset(0, -5).Value & "</td>" _
            & "<td align=center style='text-align:center'>" & Cell.Offset(0, -4).Value & "</td>" _
            & "<td align=center style='text-align:center'><span>&#36;</spam>" & Cell.Offset(0, -3).Value & "</td>" _
            & "<td align=center style='text-align:center'>" & Cell.Offset(0, -2).Value & "</td>" _
            & "</tr>"

    For Each dwn In rng.Offset(NmeRow - 1, 0)
    If dwn.Value = Cell.Value Then
    AddRow = "<tr>" _
            & "<td align=center style='text-align:center'>" & dwn.Offset(0, -6).Value & "</td>" _
            & "<td align=center style='text-align:center'>" & dwn.Offset(0, -5).Value & "</td>" _
            & "<td align=center style='text-align:center'>" & dwn.Offset(0, -4).Value & "</span></td>" _
            & "<td align=center style='text-align:center'><span>&#36;</span>" & dwn.Offset(0, -3).Value & "</td>" _
            & "<td align=center style='text-align:center'>" & dwn.Offset(0, -2).Value & "</td>" _
            & "</tr>"

    dwn.Offset(0, 1).Value = "yes"
    MailBody = MailBody & AddRow  'column A
    End If

    AddRow = ""
    Next
        With OutMail
            .To = MailTo
            .Subject = MailSubject
            '.Attachments.Add lPath, 1, 0
            .HTMLBody = "<html>" & Logo & Greeting & Message & tableHdr & MailBody & "</table>" & Break & RCMSignature & "</html>"
            .Save
            '.Close
            '.Display
            '.Send
            
          
          
       End With
        
    Cell.Offset(0, 1).Value = "yes"
 
  End If
 End If
 
 
MailTo = ""
MailSubject = ""
MailBody = ""
Next
 Range("J2:J" & x).ClearContents
End Sub
Function ProperLastRow(sh As Worksheet) As Variant
  On Error Resume Next
  ProperLastRow = sh.Cells.Find(What:="*", _
                        lookat:=xlWhole, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
                        
End Function

 

[Micron]

Is there a way to enter the message in a cell and keep its formatting in the email?

Yes, but if there is a way to copy and paste verbatim (i.e. copying font formats) into an email I don't know it. AFAIK, you'd have to use html to format in the email, which means a coder would have to know what that format should look like. All you need for the variable message is to substitute a sheet/range reference. No idea which of your paragraphs that involves or which sheet/cell it would be coming from so I have no concrete suggestion on where it goes or what to write for that.