Extract Data with number and Send as email VBA CODE

MHA535

New Member
Joined
Apr 28, 2018
Messages
5
qRUmSJw
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 Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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.
 
Upvote 0
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 = fso_OpenTextFile(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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,266
Members
448,558
Latest member
aivin

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