Code for this Thread:
http://www.excelfox.com/forum/showth...and-send-email

Code:
Option Explicit
Private Sub Workbook_Open()
Rem 1 Worksheets Info.
Dim Ws As Worksheet: Set Ws = ThisWorkbook.Worksheets("Equipment PM")
Dim Lr As Long: Let Lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row
Rem 2 data range
Dim arrIn() As Variant: Let arrIn() = Ws.Range("A1:K" & Lr & "").Value2
Rem 3 Todays date as Double(Long) number
Dim TdyDbl As Long: Let TdyDbl = CLng(Now()) ' like 43233 for 13 May 2018
 Let TdyDbl = CLng(DateSerial(2018, 3, 15)) - 3 ' To test only #####
Rem 4 Rows for due date for next service for weekly(G), Monthly(I), and Quarterly(K). Code to pick up the date from these columns and automatic send email notification 3 days before the due date.
'4a) determine rows as string or those row numbers
Dim Rw As Long
    For Rw = 4 To Lr Step 1
        If arrIn(Rw, 7) = TdyDbl + 3 Or arrIn(Rw, 9) = TdyDbl + 3 Or arrIn(Rw, 11) = TdyDbl + 3 Then
    Dim strRws As String 'String of rows for criteria met in  G   Or  I  Or  K
     Let strRws = strRws & " " & Rw
        Else ' No "3 days before due service date" criteria met for this row
        End If
    Next Rw
    If strRws = "" Then Exit Sub ' case no criteria met for the day this workbook was opened.
 Let strRws = VBA.Strings.Mid$(strRws, 2) ' take off first space
'4b) Array of rows
Dim arrRws() As String: Let arrRws() = VBA.Strings.Split(strRws, " ", -1, vbBinaryCompare)
Rem 5 HTML Table of required output '
Dim ProTble As String
'5a) Table start
Let ProTble = _
"<table width=520>" & vbCrLf & _
"<col width=30>" & vbCrLf & _
"<col width=150>" & vbCrLf & _
"<col width=150>" & vbCrLf & _
"<col width=150>" & vbCrLf & _
"<col width=40>" & vbCrLf & vbCrLf
'5b) data rows
Dim iCnt As Long, jCntStear As Variant, jCnt As Long ' data "columns" ,     "rows"
    For Each jCntStear In arrRws() ' To Loop for all rows meeting criteria
     Let jCnt = jCnt + 1  ' Rows count for table to send
    Dim LisRoe As String
     Let LisRoe = LisRoe & "<tr height=16>" & vbCrLf
        For iCnt = 1 To 5
         Let LisRoe = LisRoe & "<td>" & arrIn(arrRws(jCnt - 1), iCnt) & "</td>" & vbCrLf ' -1 is because Split Function returns array of string types in 1 Dimensional array starting at indice 0, so our jCnt is one too big
        Next iCnt
     Let LisRoe = LisRoe & "</tr>" & vbCrLf & vbCrLf
     Let ProTble = ProTble & LisRoe
     Let LisRoe = ""
    Next jCntStear
 Let ProTble = ProTble & "</table>" ' table end
 Debug.Print ProTble
Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showth...once#post10519
'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
    With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
    Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
     .Configuration(LCD_CW & "smtpusessl") = True '
     .Configuration(LCD_CW & "smtpauthenticate") = 1  '
    '  ' Sever info
     .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
    '  The mechanism to use to send messages.
     .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
     .Configuration(LCD_CW & "smtpserverport") = 25 ' 465 or 25 for t-online.de 'or 587 'or 25
    '

     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
    ' Optional - How long to try
     .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
    ' Intraction protocol is Set/ Updated
     .Configuration.Fields.Update '
    'End With ' ----------------------      my Created  LCDCW Library
    'With ' --- ' Data to be sent------     my Created  LCDCW Library
     Dim strHTML As String: Let strHTML = ProTble 'ProTble(rngArr()) ' Let strHTML = RangetoHTML(rng)
    '         Dim Highway1 As Long: Let Highway1 = FreeFile(0) '
    '          Open ThisWorkbook.Path & "" & "jawaharse.txt" For Output As #Highway1 '
    '          Print #Highway1, strHTML
    '          Close #Highway1
    .To = "Doc.AElstein@t-online.de" '
    .cc = ""
    .BCC = ""
    .from = """Equipment- Maint Records.xlsm"" <YourEMailAddresseOrAnyCrap>"
    .Subject = Ws.Range("A1").Value
    .HTMLBody = strHTML
    '        .AddAttachment ThisWorkbook.Path & "\jawaharse.txt"
    .Send ' Do it
    End With ' CreateObject("CDO.Message") -----my Created  LCDCW Library
End Sub