VBA Email notification not sending out when its a different case

Windowtothewall · Sep 7, 2021

Hey Guys,

I have inherited some code from an ex colleague that he didnt get to finish before he moved on, and I cant seem to get to work and would like some assistance on please.

The error I'm getting is:

Run Time error -2147467259 (80004005)

Outlook does not recognize one or more names

The code is for a Submit Form which sends emails out to selected addresses from a reference table if YES is displayed.

Problem is, it works only when selecting Severity = Critical. But not the other two options (Major and Minor)

When debugging it highlights the text in RED below

'Create array of email addresses
Dim checkrange As Range

Select Case cbSeverity.Value
Case "Critical"
Set checkrange = Range("C2", Range("C2").End(xlDown))
For Each cell In checkrange
If cell = "Yes" Then
Set objEmail = objOutlook.CreateItem(0)
With objEmail
.to = cell.Offset(0, -1).Value
.Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
.body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
& "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
& "Location: " & entLocation & vbNewLine _
& "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
& "Description: " & entDescription.Value & vbNewLine _
& "Severity: " & cbSeverity.Value & vbNewLine _
& "Priority: " & cbPriority.Value & vbNewLine _
& "Target Date: " & entTargetDate.Value
.Send
Set objEmail = Nothing
End With
End If
Next cell
Case "Major"
Set checkrange = Range("D2", Range("D2").End(xlDown))
For Each cell In checkrange
If cell = "Yes" Then
Set objEmail = objOutlook.CreateItem(0)
With objEmail
.to = cell.Offset(0, -1).Value
.Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
.body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
& "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
& "Location: " & entLocation & vbNewLine _
& "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
& "Description: " & entDescription.Value & vbNewLine _
& "Severity: " & cbSeverity.Value & vbNewLine _
& "Priority: " & cbPriority.Value & vbNewLine _
& "Target Date: " & entTargetDate.Value
.Send
Set objEmail = Nothing
End With
End If
Next cell
Case "Minor"
Set checkrange = Range("E2", Range("E2").End(xlDown))
For Each cell In checkrange
If cell = "Yes" Then
Set objEmail = objOutlook.CreateItem(0)
With objEmail
.to = cell.Offset(0, -1).Value
.Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
.body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
& "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
& "Location: " & entLocation & vbNewLine _
& "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
& "Description: " & entDescription.Value & vbNewLine _
& "Severity: " & cbSeverity.Value & vbNewLine _
& "Priority: " & cbPriority.Value & vbNewLine _
& "Target Date: " & entTargetDate.Value
.Send
Set objEmail = Nothing
End With
End If
Next cell
End Select

Michael M · Sep 7, 2021

where is this variable declared AND what is it's value ?

VBA Code:

cbSeverity.Value

Also, can you please use code tags when posting code....Simply press the VBA button in the reply toolbar, then paste the code where the cursor is flashing between the tags.
ALSO.....Is that ALL of the code ??
Can you also post a SMALL sample of your data layout...using XL2BB, see my signature block for this.

Windowtothewall · Sep 7, 2021

My apologies. If i have done this incorrectly still let me know.

Here is the where it is taking the data from.

VBA Code:

cbSeverity.Value

is taken from the Cells with Yes in them, ignore Pm overdue. ( separate function)



Email Notification Reference
Name	Email	Critical EMR	Major EMR	Minor EMR	Initial	PM Due in 3 Days	PM Overdue

Mitch		Yes	Yes	Yes	MM	Yes	Yes

Here is the data table

EMR Log v2.5.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

10

09-Jun-21

Equipment

Nilfisk Floor Scrubber

Mitch

Engineering

Production

NA

Vacuum suction not working

NA

Minor

2

10-Jun-21

Mitch

Fuse blown and lose terminal. Clean vacuum motor, crimp terminal and replace with new fuse.

$ 15.34

15-Jun-21

RC

Closed

11

21-002

11-Jun-21

Equipment

APAC

Ronald

Engineering

Production

NA

PLC software update and Sauce Mix Hopper Nozzle Division

NA

Minor

1

11-Jun-21

Zane, Mitch, Ronald

New software feature for sauce mix auger timer and vacuum conveyor. New "flower" divider at sauce mix hopper nozzle. Update PMB dosing speed from 2500 to 1200

$ -

15-Jun-21

RC

Closed

12

21-003

16-Jun-21

Equipment

Boiler Ignitor

Mitch

Engineering

Warehouse

NA

Ignitor Locking Out, reset 8 times to get it to fire.

NA

Critical

3

16-Jun-21

Mitch

ABS have been contacted 16-6-21

$ -

24-Jun-21

RC

Mitch reset it by pulling the plunger at gas line pressure relief valve.

Closed

13

21-004

16-Jun-21

Equipment

Oxygen Absorber Machine

Production Team

Engineering

Production

2814:001

Cutting at incorrect intervals. Faulting on end of film when film is not at end.

NA

Major

2

16-Jun-21

Ronald

Readjusted the Green Film detection Sensor. Linear Slide worn.

$ -

16-Jun-21

RC

New Linear Slide needed.

Closed

14

21-005

24-Jun-21

Equipment

Ray75

Leighton

Engineering

Warehouse

NA

A9 error on Ammonia Shut off valve vapor trap side 1 H1G1Q3

NA

Major

2

15-Sep-21

Sarah from TaitControl is tied up. New software schedule on early Sept.

$ -

Open

15

21-006

24-Jun-21

Equipment

APAC

Ronald

Engineering

Production

NA

New suction cups on st#1 bag pickup and st#1 zipper open. Readjust all 6 new suction cups positions. Add in filters for bag pickup suction cups. Install vacuum conveyor. Clean heat sealer bar and replace the teflon tape. Load new software for vacuum conveyor

NA

Major

2

30-Jun-21

Ronald

N/A

$ -

31-Jul-21

MM

N/A

Closed

16

21-007

24-Jun-21

Equipment

Ammonia Compressor

Mitch

Engineering

Plant Room

NA

Ammonia leaks at air compressor 2, triggered alarm.

NA

Major

1

25-Jun-21

CIR - Contractor

Notified service company to repair the leaks. Leak location found and 4 o-ring replaced.

$ -

25-Jun-21

RC

Closed

17

21-008

20-Jul-21

Equipment

APAC

Mitch

Engineering

Production

na

Suction cup broken, gripper missing. Bags sealing on angle

NA

Critical

1

21/7/2021

20-Jul-21

Replaced gripper and glued in. Cam 17 350-100 changed to 350-180, grippers cleaned, Infeed conveyor gap decreased

$ -

20-Jul-21

MM

Lost Gripper found by Pita on top of Nuripack base.

Closed

18

21-009

22-Jul-21

Equipment

APAC Grippers

Pita

Production

APAC

NA

Gripper 2 & 10 often dislodge and need to be put back in place.

Critical

2

27/07/2021

Open

19

21-010

07-Sep-21

Equipment

Work Bench

Michael

Production

Tray Loading

Welding has deteriorated on weighing platform

Critical

2

09-Oct-21

Open

EMR_Log

Cell Formulas
Range	Formula
U10:U19	U10	=IF(ISBLANK([@[Target Date]]),"", IF([@[Closure Date]]<>"","Closed",IF([@[Date Repairs Completed]]<>"", "Pending",IF(TODAY()>[@[Target Date]],"Overdue","Open"))))

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A10:U19	Expression	=$A10=0	text	YES
A10:U19	Expression	=$U10="Open"	text	NO
A10:U19	Expression	=$U10="Closed"	text	NO
A10:U19	Expression	=$U10="Pending"	text	NO
A10:U19	Expression	=$U10="Overdue"	text	NO

Cells with Data Validation
Cell	Allow	Criteria
K10:K19	List	=$E$3:$E$5
L10:L19	List	=$J$3:$J$5

Code Tagged. This is all the code relating to this function. Let me know if you need more,

VBA Code:

Private Sub btnDone_Click()

Sheet1.Activate

'Email new EMR
Dim objOutlook As Object

Set objOutlook = CreateObject("Outlook.Application")
Dim objEmail As Object



'Create array of email addresses
Dim checkrange As Range

Select Case cbSeverity.Value
   Case "Critical"
   Set checkrange = Range("C2", Range("C2").End(xlDown))
       For Each cell In checkrange
           If cell = "Yes" Then
           Set objEmail = objOutlook.CreateItem(0)
           With objEmail
               .to = cell.Offset(0, -1).Value
               .Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
               .body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
                       & "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
                       & "Location: " & entLocation & vbNewLine _
                       & "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
                       & "Description: " & entDescription.Value & vbNewLine _
                       & "Severity: " & cbSeverity.Value & vbNewLine _
                       & "Priority: " & cbPriority.Value & vbNewLine _
                       & "Target Date: " & entTargetDate.Value
               .Send
               Set objEmail = Nothing
           End With
           End If
       Next cell
   Case "Major"
   Set checkrange = Range("D2", Range("D2").End(xlDown))
       For Each cell In checkrange
           If cell = "Yes" Then
           Set objEmail = objOutlook.CreateItem(0)
           With objEmail
               .to = cell.Offset(0, -1).Value
               .Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
               .body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
                       & "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
                       & "Location: " & entLocation & vbNewLine _
                       & "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
                       & "Description: " & entDescription.Value & vbNewLine _
                       & "Severity: " & cbSeverity.Value & vbNewLine _
                       & "Priority: " & cbPriority.Value & vbNewLine _
                       & "Target Date: " & entTargetDate.Value
               .Send
               Set objEmail = Nothing
           End With
           End If
       Next cell
   Case "Minor"
   Set checkrange = Range("E2", Range("E2").End(xlDown))
       For Each cell In checkrange
           If cell = "Yes" Then
           Set objEmail = objOutlook.CreateItem(0)
           With objEmail
               .to = cell.Offset(0, -1).Value
               .Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
               .body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
                       & "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
                       & "Location: " & entLocation & vbNewLine _
                       & "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
                       & "Description: " & entDescription.Value & vbNewLine _
                       & "Severity: " & cbSeverity.Value & vbNewLine _
                       & "Priority: " & cbPriority.Value & vbNewLine _
                       & "Target Date: " & entTargetDate.Value
               .Send
               Set objEmail = Nothing
           End With
           End If
       Next cell
End Select


Set objOutlook = Nothing

Michael M · Sep 7, 2021

cbSeverity.Value
OK, but you are not telling the code what that value is !!
What cell does it refer to in your table ??
AND
Shouldn't the Case be "Critical EMR","Major EMR","Minor EMR"

Windowtothewall · Sep 7, 2021

Michael M said:
cbSeverity.Value
OK, but you are not telling the code what that value is !!
What cell does it refer to in your table ??
AND
Shouldn't the Case be "Critical EMR","Major EMR","Minor EMR"

Regarding the last comment. If I need to change it to "Critical EMR" then why does it work with "Critical"?

Michael M · Sep 7, 2021

First things first...Is cbSeverity a Named Range ??
If so what range does it refer to ??

Michael M · Sep 7, 2021

Can you upload the workbook to a hosting site, Dropbox for instance, and I'll take a closer look.
I think a checkbox, comboBox or dropdown is being selected to trigger the cbseverity.value

Windowtothewall · Sep 7, 2021

This is the New data Entry Button we are using, this lets us enter what issues we are having with what machine, and emails the specific person depending on Severity via the dropdown. Im so sorry i shouldve stated this earlier. Its been a long night/morning.

Windowtothewall · Sep 7, 2021

This is the Code related to the Data Entry Prompt.

VBA Code:

Dim lastEMR, newEMREnt, newEMRval

Private Sub cbCategory_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = 0
End Sub

Private Sub cbPriority_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = 0
End Sub

Private Sub cbSeverity_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = 0
End Sub

Private Sub Label11_Click()

End Sub

Private Sub lblEMR_Click()

End Sub

Private Sub lblName_Click()

End Sub

Private Sub UserForm_Initialize()
    'Add items to department list
    cbDepartment.AddItem "Engineering"
    cbDepartment.AddItem "Production"
    cbDepartment.AddItem "QA"
    
    'Add items to category list
    cbCategory.AddItem "Equipment"
    cbCategory.AddItem "Utilities"
    cbCategory.AddItem "Building"
    cbCategory.AddItem "HVAC"
    
    'Add items to severity
    cbSeverity.AddItem "Critical"
    cbSeverity.AddItem "Major"
    cbSeverity.AddItem "Minor"
    
    'Add items to priority
    cbPriority.AddItem "1"
    cbPriority.AddItem "2"
    cbPriority.AddItem "3"
    
    With NewEMR.entTargetDate
    .Text = "dd/mm/yy"
    .ForeColor = RGB(204, 204, 204)
    .Font.Size = 8
    
    lastEMR = Range("A10").End(xlDown).Value
    newEMRval = CInt(Right(lastEMR, 3)) + 1
    newEMREnt = Format(Date, "yy") & Format(newEMRval, "-000")
    lblEMR.Caption = newEMREnt
End With
    
End Sub

Private Sub btnCancel_Click()
    Unload Me
End Sub

Private Sub btnDone_Click()

Sheet1.Activate

'Email new EMR
Dim objOutlook As Object

Set objOutlook = CreateObject("Outlook.Application")
Dim objEmail As Object



'Create array of email addresses
Dim checkrange As Range

Select Case cbSeverity.Value
   Case "Critical"
   Set checkrange = Range("C2", Range("C2").End(xlDown))
       For Each cell In checkrange
           If cell = "Yes" Then
           Set objEmail = objOutlook.CreateItem(0)
           With objEmail
               .to = cell.Offset(0, -1).Value
               .Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
               .body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
                       & "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
                       & "Location: " & entLocation & vbNewLine _
                       & "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
                       & "Description: " & entDescription.Value & vbNewLine _
                       & "Severity: " & cbSeverity.Value & vbNewLine _
                       & "Priority: " & cbPriority.Value & vbNewLine _
                       & "Target Date: " & entTargetDate.Value
               .Send
               Set objEmail = Nothing
           End With
           End If
       Next cell
   Case "Major"
   Set checkrange = Range("D2", Range("D2").End(xlDown))
       For Each cell In checkrange
           If cell = "Yes" Then
           Set objEmail = objOutlook.CreateItem(0)
           With objEmail
               .to = cell.Offset(0, -1).Value
               .Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
               .body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
                       & "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
                       & "Location: " & entLocation & vbNewLine _
                       & "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
                       & "Description: " & entDescription.Value & vbNewLine _
                       & "Severity: " & cbSeverity.Value & vbNewLine _
                       & "Priority: " & cbPriority.Value & vbNewLine _
                       & "Target Date: " & entTargetDate.Value
               .Send
               Set objEmail = Nothing
           End With
           End If
       Next cell
   Case "Minor"
   Set checkrange = Range("E2", Range("E2").End(xlDown))
       For Each cell In checkrange
           If cell = "Yes" Then
           Set objEmail = objOutlook.CreateItem(0)
           With objEmail
               .to = cell.Offset(0, -1).Value
               .Subject = "New Equipment Maintanence Request - " & cbSeverity.Value
               .body = "New equipment maintanence request from " & entName.Value & " on " & Date & ", EMR: " & newEMREnt & vbNewLine _
                       & "Category: " & cbCategory.Value & ", Equipment: " & entEquipment.Value & vbNewLine _
                       & "Location: " & entLocation & vbNewLine _
                       & "Effected material code/ product code/ workorder: " & entCode.Value & vbNewLine _
                       & "Description: " & entDescription.Value & vbNewLine _
                       & "Severity: " & cbSeverity.Value & vbNewLine _
                       & "Priority: " & cbPriority.Value & vbNewLine _
                       & "Target Date: " & entTargetDate.Value
               .Send
               Set objEmail = Nothing
           End With
           End If
       Next cell
End Select


Set objOutlook = Nothing

'Log to EMR log
Dim emptyRow
Sheet2.Activate

'Check all entrys populated on user form and target date is valid
If Not IsDate(entTargetDate.Text) Then
    MsgBox """Target Date is not Valid, Please Try Again"""
ElseIf cbCategory.Value = "" Or entEquipment.Value = "" Or entName.Value = "" Or cbDepartment.Value = "" Or entLocation.Value = "" Or entDescription.Value = "" Or cbSeverity.Value = "" Or cbPriority.Value = "" Then
    MsgBox """One or More Enters are Invalid"""
Else
'If all valid
'   vvv
'Insert new emr into new row with year before it
    Range("A10").End(xlDown).Offset(1, 0).Value = newEMREnt
    'Populate table
    Range("A10").End(xlDown).Offset(0, 1).Value = Date
    Range("A10").End(xlDown).Offset(0, 2).Value = cbCategory.Value
    Range("A10").End(xlDown).Offset(0, 3).Value = entEquipment.Value
    Range("A10").End(xlDown).Offset(0, 4).Value = entName.Value
    Range("A10").End(xlDown).Offset(0, 5).Value = cbDepartment.Value
    Range("A10").End(xlDown).Offset(0, 6).Value = entLocation.Value
    Range("A10").End(xlDown).Offset(0, 7).Value = entCode.Value
    Range("A10").End(xlDown).Offset(0, 8).Value = entDescription.Value
    
    If cbFilesAttached = True Then
        Range("A10").End(xlDown).Offset(0, 9).Value = Yes
    Else
        Range("A10").End(xlDown).Offset(0, 9).Value = No
    End If
    
    Range("A10").End(xlDown).Offset(0, 10).Value = cbSeverity.Value
    Range("A10").End(xlDown).Offset(0, 11).Value = cbPriority.Value
    Range("A10").End(xlDown).Offset(0, 12).Value = entTargetDate.Value
'Close user form
Unload Me
End If
    
End Sub

Private Sub entTargetDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With NewEMR.entTargetDate
    .Text = ""
    .ForeColor = RGB(0, 0, 51)
End With

End Sub

Windowtothewall · Sep 7, 2021

Michael M said:
First things first...Is cbSeverity a Named Range ??
If so what range does it refer to ??

Yes it is a named range, and i think it refers to the dropdown menu on the New Data Entry Prompt. i think.

VBA Email notification not sending out when its a different case

Windowtothewall

New Member

Excel Facts

Michael M

Well-known Member

Windowtothewall

New Member

Michael M

Well-known Member

Windowtothewall

New Member

Michael M

Well-known Member

Michael M

Well-known Member

Windowtothewall

New Member

Attachments

Windowtothewall

New Member

Windowtothewall

New Member

Forum statistics

Share this page

VBA Email notification not sending out when its a different case

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Attachments

New Member

New Member

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock