Generate and send invoice email (from outlook) based on data in excel

[gwstat001]

Good day,

Please may you assist me in creating a macro that sends out invoices on the 25th of every month for payment due next month (e.g. sent on 25 July for August payments) to emails specified in an excel sheet. The email must:

1. be sent to the right person's email e.g. John.Alpha@gmail.com
2. with the right invoice month in the subject line e.g. August [not critical]
3. contain the right person's name in the email body e.g. John
4. with the right invoice month in the email body e.g. August 2021
5. with the right contributions due

Please find attached the sample excel sheet and the type of email I'd like to send, as well as extract below.

Kind Regards

EMAIL:
EMAIL FROM: accounts@investmentcompany.com
EMAIL TO: [John.Alpha@gmail.com]
SUBJECT LINE: RE: [August] Contribution Statement
EMAIL BODY:

---

​

Good day [John],

The details of your contributions due are as follows:
===================================================
Invoice: Contributions due for the month of [August 2021]
Contributions Due: [$1, 000.00]
===================================================

---

​

EXCEL:

	CONTRIBUTIONS SCHEDULE
				Apr-21	May-21	Jun-21	Jul-21	Aug-21	Sep-21
	Reference	Surname	Email
1	John	Alpha	John.Alpha@gmail.com	$1,000.00	$1,000.00	$1,000.00	$1,000.00	$1,000.00
2	Jane	Beta	Jane.Beta@gmail.com	$1,500.00	$1,500.00	$1,500.00	$1,500.00	$1,500.00
3	Anne	Charlie	Anne.Charlie@gmail.com	$2,000.00	$2,000.00	$ -	$2,000.00	$ -
4	Arnold	Delta	Arnold.Delta@gmail.com	$2,500.00	$2,500.00	$ 500.00	$ -	$2,500.00

 

[Logit]

Review the attached file link. NOTE: the workbook code is not adjusted to match your exact layout ... BUT ... it has everything you need to accomplish your goal.
Take time to review the code .. make some changes on your own and see what happens. Learn from your code edits.

It will take some work on your part to match the provided code so it fits your example layout. Give it a shot.

Option Explicit

Sub Mail_Selection_Range_Outlook_Body2()
Dim rng As Range
Dim Row As Range
Dim OutApp As Object
Dim OutMail As Object
Dim Value As String
Dim x As Long
Dim cell As Range
Dim hdr As Range

For x = 2 To Range("A1").End(xlDown).Row
Set rng = Nothing

'On Error Resume Next
    
' Only send the visible cells in the selection.
Set rng = Range(Cells(x, 3), Cells(x, 8))
Set hdr = ActiveSheet.Range("C1:H1")
If rng Is Nothing Then
    MsgBox "An unknown error has occurred. "
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = Cells(x, 1).Value
    .CC = ""
    .BCC = ""
    .Subject = "Your TAT Report "
    .HTMLBody = Cells(x, 2).Value & ", " & "please find your individual TAT status below." _
                & "<br></br>" & "<br></br>" & RangetoHTML(hdr) & RangetoHTML(rng) & "<br></br>" & "<br></br>" & "Text below Excel cells."
    
    .Display
   ' .Send
    
End With
Next x
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
Set OutMail = Nothing
Set OutApp = Nothing
ActiveCell.Offset(1, 0).Select

End Sub

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

WORKS - Multiple Individual Emails w Different Row To Each.xlsm

 

[gwstat001]

Thank you for this. Let me try it out. Thank you.