Skip to main content
Support is Offline
Today is our off day. We are taking some rest and will come back stronger tomorrow
Official support hours
Monday To Friday
From 09:00 To 17:30
  Thursday, 17 February 2022
  1 Replies
  5.4K Visits
0
Votes
Undo
So I used this excellent article How to automatically send email based on cell value in Excel? (extendoffice.com) and scrapped together answers from the replies to get this working as I need it to but the last piece I can't figure out is how to duplicate what I've done to run for multiple cells. I've tried to copy/paste and rearrange the code with different values like C4, C5, etc. but I always get errors. I have it working great to where if the value in C3 is < 5 it will send an email when the workbook is saved.What I need now, since this is for an inventory sheet, is to have multiple other cell values checked at different values. For example, if only C3 < 5 send an email. If only C4 is < 6 send an email. If C3 < 5, C4 is < 6 and C5 < 3 send an email. It would be nice if only one email is generated on save with all of the values that matched the < criteria.In real-world terms (not coding terms), the spreadsheet is a place for technicians to check in and out items from storage. What I am trying to do is have an email automatically sent when someone saves the workbook and the inventory level of an item has dropped below a specific value so I know that an order needs to be placed soon. So far this is my code:

ThisWorkbook
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error Resume Next
Dim xI As Integer
Dim xRg As Range
Set xRg = Range("Information!C3")
xI = Int(xRg.Value)
If xI < 5 Then
Call Mail_small_Text_Outlook
End If
End Sub

Module1
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
Range("Information!C3") & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
2 years ago
·
#2473
0
Votes
Undo
Hi Jake,

According to your needs, please find ThisWorkbook in the Microsoft Visual Basic Applications window.
  567959C0-D2E1-4819-85E7-FA20A3D06BE9.png

Double-click ThisWorkbook and copy the code below:

'Update by Extendoffice 2022/2/17
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

On Error Resume Next

Dim RgC3 As Range
Dim RgC4 As Range
Dim RgC5 As Range

Set RgC3 = Range("Information!C3")
Set RgC4 = Range("Information!C4")
Set RgC5 = Range("Information!C5")


If (IsNumeric(RgC3) And RgC3.Value < 5) And (IsNumeric(RgC4) And RgC4.Value < 6) And (IsNumeric(RgC5) And RgC5.Value < 3) Then
Call Mail_small_Text_Outlook

ElseIf IsNumeric(RgC3) And RgC3.Value < 5 Then
Call Mail_small_Text_Outlook

ElseIf IsNumeric(RgC4) And RgC4.Value < 6 Then
Call Mail_small_Text_Outlook

End If

End Sub


Sub Mail_small_Text_Outlook()


Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
Range("Information!C3") & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

End Sub


Please change the xMailBody part as you need.

Amanda
  • Page :
  • 1
There are no replies made for this post yet.