Extract Data with number and Send as email VBA CODE

[MHA535]

HII have inventory Tracking System and What I'm trying to do is create a VBA code that Extracts data if Either of the two conditions is Matched and open outlook Email object to send Email to Purchasing Department.(SEE ATTACHED SCREENSHOT)
https://www.dropbox.com/s/g4kbaknz6ib9vbb/Send Email Macro.jpg?dl=0

the two Conditions are:

-Min Stock is 5
or
-The expiry date is reached



I have already written code that open outlook mail but I'm unable to figure out How I can extract data with two conditions and add that data to Email as table.
Is there any Expert that can help?

 

[Excel Planet]

You might want to look at this to incorporate a table into body of your mail. I would personally suggest pasting the new table with your criteria to a new workbook and have that file attached to your mail.

 

[MHA535]

Thanks for Sharing video.

Can you share the code you used in the video?

 

[Excel Planet]

Ensure making a ref to Microsoft Outlook and Microsoft Scripting Runtime through Tools > Preferences and try below and let us know the outcome.

Sub Paste_Excel_Range_To_Mail_Body()
Dim rng As Range
Dim Wb As Workbook
Application.ScreenUpdating = False

'Ensure range is selected before it gets copied
Selection.Copy
Set rng = Selection
Path = Environ("Userprofile") & "\Desktop\tem.html"
Set Wb = Workbooks.Add
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.PasteSpecial xlPasteFormats
ActiveCell.PasteSpecial xlPasteColumnWidths
Wb.PublishObjects.Add(xlSourceRange, Path, Wb.Sheets(1).Name, Wb.Sheets(1).UsedRange.Address, xlHtmlStatic).Publish (True)
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim final_file As Scripting.TextStream
Set final_file = fspenTextFile(Path, ForReading)
Dim readme As Variant
readme = final_file.ReadAll
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Dear XXX," & vbNewLine & vbNewLine & _
"Please find below the details.<br>" & "<table align = left >" & readme & "</table>" & "<br>"

On Error Resume Next

With OutMail
.Display
.body = ""
.HTMLBody = strbody & .HTMLBody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

final_file.Close

Kill Path
Application.ScreenUpdating = True

End Sub

 

[Excel Planet]

Apology for the inconvenience. Please download the file here