djonik1234
New Member
- Joined
- Mar 30, 2022
- Messages
- 29
- Office Version
- 365
- Platform
- Windows
I am trying to set up my inventory worksheet to automatically send emails. when items in the inventory get low. I found a code that I modified and everything work but the code is based on one specific cell "G13". Couple things that I am trying to change and achieve in that code.
1. Change the code to look for multiple cells in column H, I and J that have words typed in those cells and not numbers. Specifically send email when those cells in column H, I and J say "2 Tools Worth"
2. In the body of the email to include all caster type that have changed their status to "2 Tools Worth".
See attachments for reference and Here is my code.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 6 Then Exit Sub
If Not Application.Intersect(Range("G13"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value = 5 Then
Call Mail_small_Text_Outlook
End If
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "This is automated email to inform you that inventory status for casters/fixtures described below has change to '2 Tools Worth':" & vbNewLine & vbNewLine & _
"MPB/STB: Docking Casters" & vbNewLine & _
"Confirm there are enough for tools that are on schedule to be moved out."
On Error Resume Next
With OutMail
.To = "email goes here"
.CC = ""
.BCC = ""
.Subject = "Inventory low on some Casters/Fixtures!"
.Body = strbody
.Attachments.Add ("My Attachment link")
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
1. Change the code to look for multiple cells in column H, I and J that have words typed in those cells and not numbers. Specifically send email when those cells in column H, I and J say "2 Tools Worth"
2. In the body of the email to include all caster type that have changed their status to "2 Tools Worth".
See attachments for reference and Here is my code.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 6 Then Exit Sub
If Not Application.Intersect(Range("G13"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value = 5 Then
Call Mail_small_Text_Outlook
End If
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "This is automated email to inform you that inventory status for casters/fixtures described below has change to '2 Tools Worth':" & vbNewLine & vbNewLine & _
"MPB/STB: Docking Casters" & vbNewLine & _
"Confirm there are enough for tools that are on schedule to be moved out."
On Error Resume Next
With OutMail
.To = "email goes here"
.CC = ""
.BCC = ""
.Subject = "Inventory low on some Casters/Fixtures!"
.Body = strbody
.Attachments.Add ("My Attachment link")
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
