Good day everyone.
I am trying to make this code run so every time I open it so excel automatically checks for expired equipment, put message about it and then send it to Outlook.
Ideally i want all outdated equipment to be listed in email too.
For example if equipment flagged already as "ALERT!", excel upon openning file just do not do anything
i tried to copy the code to Workbook section and insert it there but it is not working.
your help is appreciated
I am trying to make this code run so every time I open it so excel automatically checks for expired equipment, put message about it and then send it to Outlook.
Ideally i want all outdated equipment to be listed in email too.
For example if equipment flagged already as "ALERT!", excel upon openning file just do not do anything
i tried to copy the code to Workbook section and insert it there but it is not working.
VBA Code:
Private Sub Workbook_Open()
' I put my code there
End Sub
VBA Code:
Dim exRg As String
Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("E2:E10000"), Target)
If xRg Is Nothing Then Exit Sub
exRg = Target.Offset(0, -4)
If IsNumeric(Target.Value) And Target.Value < 14 And Target.Value > 0 Then
MsgBox exRg & " is Expired"
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
'Dim xWorkSheet As Worksheet
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Dear All," & "<br/><br/>" & "This is Autogenerated email. Please note " & exRg & " soon will be expired <br/><br/>" & "Regards,"
On Error Resume Next
With xOutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "[AUTO] " & exRg & " expiration"
.HTMLBody = xMailBody
.Display 'or use .Send
'MsgBox xOutMail.Subject
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Equipment Calibration Email Send Test - Copy.xlsm | ||||||||
---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | |||
1 | Equipment | Cert date | Expiration | TODAY Date | Days left | Status | ||
2 | Equipment N1 | 29.06.2022 | 29.06.2023 | 02.06.2023 | 27 | Warning | ||
3 | Equipment N2 | 13.06.2022 | 13.06.2023 | 02.06.2023 | 11 | ALERT! | ||
4 | Equipment N3 | 14.06.2022 | 14.06.2023 | 02.06.2023 | 12 | ALERT! | ||
5 | Equipment N4 | 15.06.2022 | 15.06.2023 | 02.06.2023 | 13 | ALERT! | ||
6 | Equipment N5 | 34 | GOOD | |||||
Sheet1 |
Cell Formulas | ||
---|---|---|
Range | Formula | |
C2:C5 | C2 | =B2+365 |
D2:D5 | D2 | =TODAY() |
E2:E5 | E2 | =C2-D2 |
F2:F6 | F2 | =IF(E2<14,"ALERT!",IF(AND(E2>=14,E2<30),"Warning","GOOD")) |
Cells with Conditional Formatting | ||||
---|---|---|---|---|
Cell | Condition | Cell Format | Stop If True | |
E:E | Other Type | Icon set | NO | |
F:F | Cell Value | contains "ALERT!" | text | NO |
F:F | Cell Value | contains "Warning" | text | NO |
F:F | Cell Value | contains "GOOD" | text | NO |
your help is appreciated