Expanding Excel > Lotus Notes mailing macro

Hi and good evening.

I'm Azlan and I'm received a project a few months ago involving Lotus Notes and Macros VBA, which both I'm not familiar with and started learning as I go.

I'm supposed to create a triggering system from Excel that sends Emails to recipients and am facing a bit of a problem.

I managed to make it read row by row, but I want it to loop the body of the email and send it to a single recipient.


This is the line of code that I have done so far.

Sub EmailSheet2Test()
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim row_number As Integer
row_number = 1

Dim Email As String, Subj As String, Msg As String
Dim Maildb As Object, UserName As String, MailDbName As String, DomDbName As String
Dim stFileName As String
Dim MailDoc As Object, Session As Object

Dim x As Long
lastrow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Range(ActiveCell, ActiveCell.End(xlDown)).Select
'For x = 2 To 11
    
   ' mydate1 = Cells(x, 4).Value
    'mydate2 = mydate1
    
    'Cells(x, 5).Value = mydate2
    
   ' datetoday1 = Date
    'datetoday2 = datetoday1
    
    'Cells(x, 6).Value = datetoday2

    Do
    'DoEvents
    row_number = row_number + 1
   ' x =
   ' If mydate2 - datetoday2 = 60 Then
    
        Set Session = CreateObject("Notes.NotesSession")
        UserName = Session.UserName
        MailDbName = "mail\" & Mid$(UserName, 4, InStr(1, UserName, " ") - 4) & Mid$(UserName, _
            InStr(1, UserName, " ") + 1, InStr(1, UserName, "/") - InStr(1, UserName, " ") - 1) & ".nsf"
        Set Maildb = Session.GetDataBase("", MailDbName)
    
        If Maildb.IsOpen = True Then
            Else: Maildb.OpenMail
        End If
    
        Set MailDoc = Maildb.CreateDocument
    
        MailDoc.Form = "Memo"
        Email = Cells(row_number, 10)
        
        With mymail
            Subj = "Your License Validity is about to expire."
            Msg = ""
            Msg = Msg & "Dear supervisor" & vbCrLf & vbCrLf
            Msg = Msg & "The purpose of this email is to notify you that your employee/subordinate's license validity is about to expire. This is the employee details: " & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 1, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 1, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 2, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 2, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 3, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 3, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 4, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 4, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 5, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 5, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 6, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 6, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 7, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 7, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 8, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 8, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & Cells(row_number + 9, 1).Text & vbCrLf
            Msg = Msg & Cells(row_number + 9, 2).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & "It will expire on: "
            Msg = Msg & Cells(row_number, 9).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & "This is the license that will expire as of the date above: "
            Msg = Msg & Cells(row_number, 3).Text & "." & vbCrLf & vbCrLf
            Msg = Msg & "Please proceed to the person responsible for license renewal. Thank you" & vbCrLf & vbCrLf
            Msg = Msg & "From HR Learning & Development " & vbCrLf
            Msg = Msg & "HR"
        
            MailDoc.sendto = Email
            MailDoc.CopyTo = Whomever
            MailDoc.BlindCopyTo = Whomever
            MailDoc.Subject = Subj
            MailDoc.Body = Msg
            MailDoc.SaveMessageOnSend = True
            MailDoc.PostedDate = Now
            MailDoc.send (False)
        'Wait two seconds before sending keystrokes
                'Application.Wait (Now + TimeValue("0:00:02"))
                'Application.SendKeys "%s"
        
        
        
        '.send
        End With
    
    
    'End If
    
    Loop Until row_number = lastrow

'Next

On Error GoTo Audi
Call MailDoc.send(False)
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing
Audi:
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing




End Sub

These are my main questions:
1) can I make the body loop instead of manually adding row numbers?
2) Is there a way to change font colour using VBA?
3) Is there any way that I can sort everything into a table in Lotus Notes?

Attached is also the excel I'm working on.


I hope all you generous people can help me in my problem.

Thank you.