Pancakes1032
11-25-2014, 08:18 AM
Hi I have this code that will send an email once a date is entered on a specific column. The code works perfect when I do it on my own computer, but this WB unfortunately has to be shared due to User Interface that I have going and 20 different people needing to open and close the workbook all day. Well, long story short my office assistant mainly does the task of entering data, but when they do it, the email doesn't send like how it should. It only works when I am the one on the WB on my own computer. They don't get any error message or anything, it just doesn't send an email like it's coded to do.
Is there anyway to get it to always send an email no matter who is using it? I don't care if my email shows or if it is another supervisor as the from. Here is the code:
This is the code for the change event on the worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.count > 1 Then Exit Sub
If Target.Column = 5 Then 'If target is in column D
If Target.Value = Date Then 'If the target value is today
Call Send_Email
End If
End If
End Sub
Here is the code in the Module:
Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hello," & vbNewLine & vbNewLine & _
"You may have new cases." & vbNewLine & _
"Please review and disposition them." & vbNewLine & _
"Thank you"
On Error Resume Next
With OutMail
.To = "Employee"
.CC = "SUPS"
.BCC = ""
.Subject = "New Case Assignments"
.Body = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Is there anyway to get it to always send an email no matter who is using it? I don't care if my email shows or if it is another supervisor as the from. Here is the code:
This is the code for the change event on the worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.count > 1 Then Exit Sub
If Target.Column = 5 Then 'If target is in column D
If Target.Value = Date Then 'If the target value is today
Call Send_Email
End If
End If
End Sub
Here is the code in the Module:
Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hello," & vbNewLine & vbNewLine & _
"You may have new cases." & vbNewLine & _
"Please review and disposition them." & vbNewLine & _
"Thank you"
On Error Resume Next
With OutMail
.To = "Employee"
.CC = "SUPS"
.BCC = ""
.Subject = "New Case Assignments"
.Body = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub