VBA reminder & send email code

J

jaxs2009

Board Regular
Joined
Nov 28, 2010
Messages
200
excel 2016 Here is my vba code

Sub datesexcelvba()
Dim myapp As Outlook.Application, mymial As Outlook.MailItem
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long


Dim x As Long


lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow


mydate1 = Cells(x, 6).Value
maydate2 = mydate1


Cells(x, 9).Value = mydate1


datetoday1 = Date
datetoday2 = datetoday1
mydate2 = mydate1


Cells(x, 10).Value = datetoday2


If mydate2 - datetoday2 = 3 Then


Set myapp = New Outlook.Application
Set mymail = myapp.CreateItem(olMailItem)
mymail.To = Cells(x, 5).Value


With mymail
.Subject = "Submittal Reminder"
.Body = "Hello I hope your day is off to a good start." & vbCrLf & "Submittals are due in three days please forward submittals as outlined to Storm Industrial Investments LLC Texas Project Team Thak you." & vbCrLf & "Kindly disregard if already submitted." & vbCrLf & "john smith"
.Display
'.send
End With


Cells(x, 7) = "Yes"
Cells(x, 7).Interior.ColorIndex = 6
Cells(x, 7).Font.ColorIndex = 3
Cells(x, 7).Font.Bold = True
Cells(x, 8).Value = mydate2 - datetoday2
End If
Next


Set myapp = Nothing
Set mymail = Nothing
End Sub


This code starts in row 2 but does not want to work beyond row 6 I can not figure out why, when it should look for last row? Also is there a fix, add/change code to have outlook insert my email signature, I believe this would be in the of code that starts with .body?

I also notice that it does not sent the email automatically, the code only open up the email(s) one would have to click on each email send button to send it, again what can we fix,add and/or change in the code to send automatically.

[TABLE="width: 1327"]
<tbody>[TR]
[TD]no.[/TD]
[TD]name[/TD]
[TD]last[/TD]
[TD]contact[/TD]
[TD]email address[/TD]
[TD]date of payment mydate1 column 6 (x,6)[/TD]
[TD]reminders column 7 (x,7)[/TD]
[TD]days diffeerence column 8 (x,8)[/TD]
[TD]date numbers mydate2 column 9 (x,9) datetoday 1 = date numbers[/TD]
[TD]today as numbers / todays date column 10 (x,10) datetoday2 = system date[/TD]
[TD="align: left"]

<tbody>
</tbody>
[/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD][/TD]
[TD]email address[/TD]
[TD="align: right"]11/30/17[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]11/30/2017[/TD]
[TD="align: right"]43069[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john [/TD]
[TD]smith[/TD]
[TD][/TD]
[TD]email address[/TD]
[TD="align: right"]12/21/17[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/21/2017[/TD]
[TD="align: right"]43069[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD][/TD]
[TD]email address[/TD]
[TD="align: right"]12/03/17[/TD]
[TD]Yes[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]12/3/2017[/TD]
[TD="align: right"]43069[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD][/TD]
[TD]email address[/TD]
[TD="align: right"]12/14/17[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/14/2017[/TD]
[TD="align: right"]43069[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD][/TD]
[TD]email address[/TD]
[TD="align: right"]12/03/17[/TD]
[TD]Yes[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]12/3/2017[/TD]
[TD="align: right"]43069[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Please paste code between code tags.

I don't see a problem with LastRow.

First, move this to before the FOR loop.
Code: 
Set myapp = New Outlook.Application
Change order...
Code: 
Set mymail = Nothing
Set myapp = Nothing

For signature, I guess you can use the htmlBody method rather than Body method. See: http://www.rondebruin.nl/win/s1/outlook/signature.htm

I prefer the WordEditor method. e.g.
Code: 
Sub EmailByDateDue()
  Dim ws As Worksheet, ws2 As Worksheet, r As Range, c As Range
  Dim f As Range, sig$, SentOnBehalfOfName$, body$, user$
  'Tools > References > Microsoft Outlook xx.0 Object Library
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library
  Dim Word As Document, wr As Word.Range
  
'****************** INPUTs ***************************************
  Set ws = Worksheets("Data")
  Set ws2 = Worksheets("Email sent Report")
  'Signature file path, must exist.
  SentOnBehalfOfName = "ken2@gmail.com"
  sig = ThisWorkbook.Path & "\sig.rtf"
  user = Environ("username")
'****************** END INPUTs ***********************************
  
  If user <> "ken" Then Exit Sub
  
  '100 day column
  Set r = ws.Range("G2", ws.Cells(Rows.Count, "G").End(xlUp))
  
  Set olApp = New Outlook.Application
  
  For Each c In r
    'If c > 100 Then GoTo NextC  'Not due yet so skip.
    If c < 95 Or c > 100 Then GoTo NextC 'Not due yet so skip.
    Set f = ws2.Columns("A").Find(ws.Cells(c.Row, "A"), ws2.[A1])
    If Not f Is Nothing Then GoTo NextC
    
    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
      .Importance = olImportanceNormal
      .To = ws.Cells(c.Row + 1, "C")
      .SentOnBehalfOfName = SentOnBehalfOfName
      .Subject = "95-100 Day Reminder"
      body = "Name: " & ws.Cells(c.Row, "C") & vbCrLf
      body = body & "Amount: " & ws.Cells(c.Row, "D") & vbCrLf
      body = body & "Serial No.: " & ws.Cells(c.Row, "A")
      
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      wr = body
      
      If Dir(sig) <> "" Then
        GetObject(sig).Content.Copy
        wr.Collapse Direction:=wdCollapseEnd
        wr.Paste  'Paste at end
      End If
            
      'https://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook._mailitem.deferreddeliverytime.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1
      '.DeferredDeliveryTime = Now + TimeValue("00:10:00")
      '.Display
      .Send
      
      'Write entry to log sheet.
      Set f = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      f = ws.Cells(c.Row, "A")  'Serial Number
      f.Offset(, 1) = ws.Cells(c.Row, "C") 'Name
      f.Offset(, 2) = ws.Cells(c.Row + 1, "C") 'Email
      f.Offset(, 3) = Date 'Reminder Sent
      f.Offset(, 3).NumberFormat = "mm/dd/yyyy"
    End With
NextC:
    Set wr = Nothing
    Set Word = Nothing
  Next c
  
  On Error Resume Next
  Set olMail = Nothing
  Set olApp = Nothing
End Sub
 
Last edited:
Upvote 0
Kenneth Hobson said:
Please paste code between code tags.

I don't see a problem with LastRow.

First, move this to before the FOR loop.
Code: 
Set myapp = New Outlook.Application
Change order...
Code: 
Set mymail = Nothing
Set myapp = Nothing

For signature, I guess you can use the htmlBody method rather than Body method. See: http://www.rondebruin.nl/win/s1/outlook/signature.htm

I prefer the WordEditor method. e.g.
Code: 
Sub EmailByDateDue()
  Dim ws As Worksheet, ws2 As Worksheet, r As Range, c As Range
  Dim f As Range, sig$, SentOnBehalfOfName$, body$, user$
  'Tools > References > Microsoft Outlook xx.0 Object Library
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library
  Dim Word As Document, wr As Word.Range
  
'****************** INPUTs ***************************************
  Set ws = Worksheets("Data")
  Set ws2 = Worksheets("Email sent Report")
  'Signature file path, must exist.
  SentOnBehalfOfName = "ken2@gmail.com"
  sig = ThisWorkbook.Path & "\sig.rtf"
  user = Environ("username")
'****************** END INPUTs ***********************************
  
  If user <> "ken" Then Exit Sub
  
  '100 day column
  Set r = ws.Range("G2", ws.Cells(Rows.Count, "G").End(xlUp))
  
  Set olApp = New Outlook.Application
  
  For Each c In r
    'If c > 100 Then GoTo NextC  'Not due yet so skip.
    If c < 95 Or c > 100 Then GoTo NextC 'Not due yet so skip.
    Set f = ws2.Columns("A").Find(ws.Cells(c.Row, "A"), ws2.[A1])
    If Not f Is Nothing Then GoTo NextC
    
    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
      .Importance = olImportanceNormal
      .To = ws.Cells(c.Row + 1, "C")
      .SentOnBehalfOfName = SentOnBehalfOfName
      .Subject = "95-100 Day Reminder"
      body = "Name: " & ws.Cells(c.Row, "C") & vbCrLf
      body = body & "Amount: " & ws.Cells(c.Row, "D") & vbCrLf
      body = body & "Serial No.: " & ws.Cells(c.Row, "A")
      
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      wr = body
      
      If Dir(sig) <> "" Then
        GetObject(sig).Content.Copy
        wr.Collapse Direction:=wdCollapseEnd
        wr.Paste  'Paste at end
      End If
            
      'https://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook._mailitem.deferreddeliverytime.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1
      '.DeferredDeliveryTime = Now + TimeValue("00:10:00")
      '.Display
      .Send
      
      'Write entry to log sheet.
      Set f = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      f = ws.Cells(c.Row, "A")  'Serial Number
      f.Offset(, 1) = ws.Cells(c.Row, "C") 'Name
      f.Offset(, 2) = ws.Cells(c.Row + 1, "C") 'Email
      f.Offset(, 3) = Date 'Reminder Sent
      f.Offset(, 3).NumberFormat = "mm/dd/yyyy"
    End With
NextC:
    Set wr = Nothing
    Set Word = Nothing
  Next c
  
  On Error Resume Next
  Set olMail = Nothing
  Set olApp = Nothing
End Sub
Click to expand...



Thank you Ken,

You will have to forgive me, I am not sure what code tags are but most certainly can paste a code where needed.

I moved the code before the FOR Loop and changed the order of set mymail & set myapp

I am still having trouble with lastrow part of the code the error is Compile error variable not defined.

here is the code to date

Option Explicit


Sub emailreminder()
Dim myapp As Outlook.Application, mymail As Outlook.MailItem
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long


Dim x As Long


lastrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Set myapp = New Outlook.Application
For x = 9 To lastrow


mydate1 = celss(x, 8).Value
mydate2 = mydate1


Cells(x, 11).Value = mydate1


datetoday1 = Date
datetoday2 = datetoday1


Cells(x, 12).Value = datetoday2


If mydate2 - datetoday2 = 3 Then


Set mymail = myapp.CreateItem(olMailItem)
mymial.To = Cells(x, 6).Value


With mymail


.Subject = "Submittal Reminder"
.Body = "Hello I hope your day is off to a good start." & vbCrLf & "We wanted to remind you that Submittals are due in 3 days please forward all Submittals related to your scope of work the the Plaza Project Team Thank you." & vbDrLf & "John Smith"
.Display
'.send
End With


Cells(x, 9) = "Yes"
Cells(x, 9).Interior.ColorIndex = 6
Cells(x, 9).Font.ColorIndex = 3
Cells(x, 9).Font.Bold = True
Cells(x, 10).Value = mydate - datetoday2
End If
Next


Set mymail = Nothing
Set myapp = Nothing
End Sub



[TABLE="width: 966"]
<colgroup><col><col><col><col><col><col span="2"><col><col><col><col></colgroup><tbody>[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]10[/TD]
[TD]11[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]SUBMITTALS[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]No.[/TD]
[TD]Submittal Description[/TD]
[TD]Subcontractor[/TD]
[TD]Contact Person[/TD]
[TD]Email[/TD]
[TD]Submittal Requested[/TD]
[TD]Required Back[/TD]
[TD]Send Reminder[/TD]
[TD]Days Difference[/TD]
[TD]Date Numbers[/TD]
[TD]Today as Numbers[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]001[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]002[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]12/3/2017[/TD]
[TD]12/13/2017[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43082[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]003[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]12/4/2017[/TD]
[TD]12/14/2017[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43083[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]004[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]12/22/2017[/TD]
[TD]1/1/2018[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43101[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]005[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]12/3/2017[/TD]
[TD]12/13/2017[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43082[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]006[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]007[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]008[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]009[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]010[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]12/3/2017[/TD]
[TD]12/13/2017[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43082[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]011[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]012[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]013[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]43070[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Thank you Ken

Thank you Ken,

You will have to forgive me, I am not sure what code tags are but most certainly can paste a code where needed.

I moved the code before the FOR Loop and changed the order of set mymail & set myapp

I am still having trouble with lastrow part of the code the error is Compile error variable not defined.

Also I like your suggested email code, can I just cut and past this code changing your name to mine as needed in the code.

Again thank you this helps me to learn given that my first degree was with a slide rule and a Texas instrument calculator.

here is the code to date

Option Explicit


Sub emailreminder()
Dim myapp As Outlook.Application, mymail As Outlook.MailItem
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long


Dim x As Long


lastrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Set myapp = New Outlook.Application
For x = 9 To lastrow


mydate1 = celss(x, 8).Value
mydate2 = mydate1


Cells(x, 11).Value = mydate1


datetoday1 = Date
datetoday2 = datetoday1


Cells(x, 12).Value = datetoday2


If mydate2 - datetoday2 = 3 Then


Set mymail = myapp.CreateItem(olMailItem)
mymial.To = Cells(x, 6).Value


With mymail


.Subject = "Submittal Reminder"
.Body = "Hello I hope your day is off to a good start." & vbCrLf & "We wanted to remind you that Submittals are due in 3 days please forward all Submittals related to your scope of work the the Plaza Project Team Thank you." & vbDrLf & "John Smith"
.Display
'.send
End With


Cells(x, 9) = "Yes"
Cells(x, 9).Interior.ColorIndex = 6
Cells(x, 9).Font.ColorIndex = 3
Cells(x, 9).Font.Bold = True
Cells(x, 10).Value = mydate - datetoday2
End If
Next


Set mymail = Nothing
Set myapp = Nothing
End Sub



[TABLE="class: cms_table, width: 966"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]10[/TD]
[TD]11[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]SUBMITTALS[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]No.[/TD]
[TD]Submittal Description[/TD]
[TD]Subcontractor[/TD]
[TD]Contact Person[/TD]
[TD]Email[/TD]
[TD]Submittal Requested[/TD]
[TD]Required Back[/TD]
[TD]Send Reminder[/TD]
[TD]Days Difference[/TD]
[TD]Date Numbers[/TD]
[TD]Today as Numbers[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]001[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]002[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]12/3/2017[/TD]
[TD]12/13/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD]43082[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]003[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]12/4/2017[/TD]
[TD]12/14/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD]43083[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]004[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]12/22/2017[/TD]
[TD]1/1/2018[/TD]
[TD][/TD]
[TD][/TD]
[TD]43101[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]005[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]12/3/2017[/TD]
[TD]12/13/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD]43082[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]006[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]007[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]008[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]009[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]010[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]12/3/2017[/TD]
[TD]12/13/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD]43082[/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]011[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]012[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]43070[/TD]
[/TR]
[TR]
[TD]013[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]43070[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
I will work up a more simple WordEditor example using what I think you need. You can then copy and paste to a Module and change it a little.

Add Dim before using LastRow to skip the Compile msg. Row variables should be Long.
Code: 
Dim LastRow as Long

After 150 posts, I would have thought that you knew how to add code tags. I just thought that you forgot. The easiest way is to click the # icon on the reply toolbar. Or, type them. e.g. (code)MsgBox "Hello World!"(/code) but replace ()'s with []'s.
 
Upvote 0
Always Compile from the Debug menu before a Run. I like to edit the VBE toolbar and add it as I do it so often. I used Option Explicit as first line of code and Require Variable Declaration in my VBE Tools > Options.

Most always, test on a backup copy using dummy data. You don't want to email someone incorrectly.

I have not tested this but it should be close. Be sure to change the path to your RTF file. Your usual signature file will be in the %APPDATA% folder. Ron de Bruin shows the path in the link that I posted for the signature HTM file. Your RTF is there as well. Or, use ANY RTF.

I used a sliderule in High School. For my first degree, I used a paint brush. For 2nd degree, I used Sharp EL5500, HP28S, and HP48SX. If you used the later, you may have seen some of my programs in some of the HORN ZIP disks/files.
Code: 
Sub emailReminder()
'Tools > References > Microsoft Outlook xx.0 Object Library
  Dim myApp As Outlook.Application, myMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library
  Dim Word As Document, wr As Word.Range
  Dim myDate1 As Date, myDate2 As Date, dateToday1 As Date, dateToday2 As Date
  Dim x As Long, lastrow As Long, ws As Worksheet, sig$

'************************** INPUT ***********************************************
  Set ws = Worksheets("Sheet1")
  sig = ThisWorkbook.Path & "\sig.rtf"
'************************** END INPUT *******************************************

  lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
  Set myApp = New Outlook.Application
  For x = 9 To lastrow
    myDate1 = ws.Cells(x, "H").Value
    myDate2 = myDate1
    ws.Cells(x, "K").Value = myDate1
    dateToday1 = Date
    dateToday2 = dateToday1
    ws.Cells(x, "L").Value = dateToday2
  
    If myDate2 - dateToday2 <> 3 Then GoTo NextX
    
    Set myMail = myApp.CreateItem(olMailItem)
    With myMail
      .To = ws.Cells(x, "F").Value
      .Subject = "Submittal Reminder"
      
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      'wr = Body
      wr = "Hello I hope your day is off to a good start." & _
        vbCrLf & "We wanted to remind you that Submittals are " & _
        "due in 3 days please forward all Submittals related to" & _
        "your scope of work the the Plaza Project Team Thank you." & _
        vbCrLf & "John Smith"
      
      If Dir(sig) <> "" Then
        GetObject(sig).Content.Copy
        wr.Collapse Direction:=wdCollapseEnd
        wr.Paste  'Paste at end
      End If
    
      .Display
      '.DeferredDeliveryTime = Now + TimeValue("00:10:00")
      '.Send
      
      Set wr = Nothing
      Set Word = Nothing
      Set myMail = Nothing
    End With
  
    With ws
      .Cells(x, "I") = "Yes"
      .Cells(x, "I").Interior.ColorIndex = 6
      .Cells(x, "I").Font.ColorIndex = 3
      .Cells(x, "I").Font.Bold = True
      .Cells(x, "J").Value = myDate1 - dateToday2 'mydate was myDate1. IS THIS RIGHT?
    End With
NextX:
  Next x
  
  Set myApp = Nothing
End Sub
 
Last edited:
Upvote 0
Yes, I figured out tags, thank you Ken. I also moved code around as outlined in your reply, it did not seem to effect any differently as originally entered.

The system will auto generate the Option Explicit but I have read to back space it out.

I want to study this over the weekend, If I don't make headway with the issues I have, if unsuccessful I can sure use your help. This vba code I have been working on would work on each of the rows yesterday but today it will only work through row 6.

On sheet 1 is more of what I want to use, sheet 2 is the test sheet for the code.

On sheet 1, I wanted the vba code to start on row 9 "For x = 9 to lastrow" AND this vba macro wont even run.

On sheet 2 "the test sheet" in the same workbook it is "For x = 2 to last row" the code only runs to row 6 and stops, yesterday it would work on any of the rows down the sheet with the appropriate date in column 6 "date of payment"

Driving me nuts.

Just below is sheet 2 the test sheet, as you can see it stops at row 6 as the date 12/04/2017 is reflected beyond the last "yes" under reminders column.

[TABLE="width: 1308"]
<tbody>[TR]
[TD]title column "A"[/TD]
[TD]first name column "B"[/TD]
[TD]last name[/TD]
[TD]mobile number[/TD]
[TD]email address[/TD]
[TD]date of payment[/TD]
[TD]reminders[/TD]
[TD]days of difference[/TD]
[TD]date numbers[/TD]
[TD]today as numbers[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD]555-123-4567[/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/1/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]43070[/TD]
[TD="align: right"]43070[/TD]
[TD="align: left"]

<tbody>
</tbody>
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD]555-123-4567[/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/21/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]43090[/TD]
[TD="align: right"]43070[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD]555-123-4567[/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/4/2017[/TD]
[TD]Yes[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]43073[/TD]
[TD="align: right"]43070[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD]555-123-4567[/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/14/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]43083[/TD]
[TD="align: right"]43070[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mr[/TD]
[TD]john[/TD]
[TD]smith[/TD]
[TD]555-123-4567[/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/4/2017[/TD]
[TD]Yes[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]43073[/TD]
[TD="align: right"]43070[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/5/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/4/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/14/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/21/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/4/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]skippynw@yhaoo.com[/TD]
[TD="align: right"]12/4/2017[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


This is the VBA code in sheet 2 module 1

Sub datesexcelvba()
Dim myapp As Outlook.Application, mymail As Outlook.MailItem
Dim mydate1 As Date
Dim mydate As Long
Dim datetoday1 As Date
Dim datetoday2 As Long


Dim x As Long

lastrow = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To lastrow

mydate1 = Cells(x, 6).Value
mydate2 = mydate1

Cells(x, 9).Value = mydate2

datetoday1 = Date
datetoday2 = datetoday1
mydate2 = mydate1

Cells(x, 10).Value = datetoday2

If mydate2 - datetoday2 = 3 Then

Set myapp = New Outlook.Application
Set mymail = myapp.CreateItem(olMailItem)

mymail.To = Cells(x, 5).Value

With mymail

.Subject = "Submittal Reminder"
.Body = "Hello hope you day is going well, Submittals are due in three days, please forward submittals to the Plaza Project Team right away. " & vbCrLf & "Kindly disregard if Submittals have already been sent. " & "Thank you"
.Display
'.send
End With

Cells(x, 7) = "Yes"
Cells(x, 7).Interior.ColorIndex = 6
Cells(x, 7).Font.ColorIndex = 3
Cells(x, 7).Font.Bold = True
Cells(x, 8).Value = mydate2 - datetoday2
End If
Next

Set myapp = Nothing
Set mymail = Nothing
End Sub



This is sheet 1 module 2 my actual sheet I want to use.

[TABLE="width: 950"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]10[/TD]
[TD]11[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: left"]

<tbody>
</tbody>
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]NO.[/TD]
[TD]Submittal Description[/TD]
[TD]Subcontractor[/TD]
[TD]Contact Person[/TD]
[TD]Email[/TD]
[TD]Submittal Requested[/TD]
[TD]Submittal Required mydate1[/TD]
[TD]Send Reminder[/TD]
[TD]Days Difference[/TD]
[TD]Date Numbers mydate2[/TD]
[TD]Today as Numbers datetoday2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]This is row 9[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] skippynw@yahoo.com[/TD]
[TD="align: right"]11/20/17[/TD]
[TD="align: right"]12/4/17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]11/25/17[/TD]
[TD="align: right"]12/10/17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/3/17[/TD]
[TD="align: right"]12/18/17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/4/17[/TD]
[TD="align: right"]12/4/17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/15/17[/TD]
[TD="align: right"]12/30/17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/25/17[/TD]
[TD="align: right"]1/9/18[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]12/4/17[/TD]
[TD="align: right"]12/4/17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

This is vba code to sheet 1 module 2, the vba that wont even run.

Sub emailreminder()
Dim myapp As Outlook.Application, mymail As Outlook.MailItem
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long

Dim x As Long

lastrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 9 To lastrow

mydate1 = Cells(x, 8).Value
maydate2 = mydate1

Cells(x, 11).Value = mydate1

datetoday1 = Date
datetoday2 = datetoday1

mydate2 = mydate1

Cells(x, 12).Value = datetoday2

If mydate2 - datetoday2 = 3 Then

Set myapp = New Outlook.Application
Set mymail = myapp.CreateItem(olMailItem)
mymail.To = Cells(x, 6).Value

With mymail

.Subject = "Submittal Reminder"
.Body = "Hello, hope your day is going well, Submittal are due in three days, please forward Submittals to the Plaza Project Team right away. " & vbCrLf & "Kindly disregard if Submittals have already been sent. " & vbCrLf & "Thank you"
.Display
'.send
End With

Cells(x, 9) = "yes"
Cells(x, 9).Interior.ColorIndex = 6
Cells(x, 9).Font.ColorIndex = 3
Cells(x, 9).Font.Bold = True
Cells(x, 10).Value = mydate2 - datetoday2
End If
Next

Set mymail = Nothing
Set myapp = Nothing

End Sub


All I ma trying to doing is take the "submittal required date" and send out a reminder three days in advance clicking a control and/or command button which will find all dates down the rows to last row and send out an email with the outlook signature.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Locked
  • Question Question
Turn .BODY outlook email into HTMLBODY using VBA
Replies
2
Views
781
RoryA
RoryA
N
  • Question Question
Turn .BODY subject body in outlook into HTMLBODY using VBA
2
Replies
10
Views
1K
nealmaher
N
R
  • Question Question
VBA Generate email with multiple data in body.
Replies
2
Views
132
Logit
Logit
crook_101
  • Question Question
VBA to loop when sending email
Replies
1
Views
272
crook_101
crook_101
C
  • Question Question
Create code that sends emails and creates a log
Replies
1
Views
315
cokeoverpepsi123
C

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top