Comparing the Dates and Sending an Email - excel

Question

I want to send an automatic mail if two conditions are met
The user input date in Cell (17,2) is > than today's date in
Cell(22,2)'
When the value in Cell (B3) = "Operation_Support"
When the above two conditions are met then I want an automatic mail to shoot up.
Can this be done?
The code is given below..
Sub datesexcelvba()
Dim OutApp As Object
Dim OutMail As Object
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim rng As Range
Dim StrBody As String
StrBody = "This is line " & "<br>" & _
"This is line " & "<br>" & _
"This is line " & "<br><br><br>"
mydate1 = Cells(17, 2).Value
mydate2 = mydate1
datetoday1 = Cells(22, 2).Value
datetoday2 = datetoday1
If mydate2 > datetoday2 & Range("B3").Value = "Operation_Support" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With mymail
.To = "x"
'& ";" & "x"
.CC = ""
.BCC = ""
.Subject = "Test Mail"
.HTMLBody = StrBody & RangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
End With
End If
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
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

Answer 1

tested your code and encountered some minor issues. Assuming your Function
RangetoHTML()
works fine, you need to change the following to lines
If mydate2 > datetoday2 & Range("B3").Value = "Operation_Support" Then
...
With mymail
...
The changes are the following: Replace the '&' with 'And' and 'mymail' with the Object you set above (in your case it is OutMail).
So your Sub would be:
Sub datesexcelvba()
Dim OutApp As Object
Dim OutMail As Object
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim rng As Range
Dim StrBody As String
StrBody = "This is line " & "<br>" & _
"This is line " & "<br>" & _
"This is line " & "<br><br><br>"
mydate1 = Cells(17, 2).Value
mydate2 = mydate1
datetoday1 = Cells(22, 2).Value
datetoday2 = datetoday1
If mydate2 > datetoday2 And Range("B3").Value = "Operation_Support" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "test#testing.com"
'& ";" & "x"
.CC = ""
.BCC = ""
.Subject = "Test Mail"
.HTMLBody = StrBody
'.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
End With
End If
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub