Automatically send email to address in column B when spreadsheet is saved

[surkdidat]

Can someone please help!

I would like Excel to either :-

a) Send an automated email to every address in column B when saved a(and exited - ideally a pompt box would come up and say "you are sxiting - would you like the email to be sent out?" or
b) Send an automated email to every address in column B when a button is pressed.

All emails can go out To (i.e. does not need to be CC or BCC)

- Subject Header needs to state "Rota Updated"
- Main body of message needs to either state "Please check the rota as it has been recently updated" or copy the cells in sheet1 from C1:h50

Many thanks

 

[paulxmw]

Hi what code have you got so far. Ill help yo amend it to what you need

 

[surkdidat]

Hi there
Below is what I have so far... what I cannot work out, or find on the web is to replace the .To = "" with whatever email addresses are in column B...... Also is there anyway this email can be sent automatically (reason for this is some users could easily just shut down the email)

Sub Email()
Dim oMailItem As Object
Dim oOLapp As Object
Set oOLapp = CreateObject("Outlook.application")
Set oMailItem = oOLapp.CreateItem(0)
With oMailItem
.To = ""
.CC = ""
.Subject = "**** Rota Update ****"
.Body = "Hello. Please note that the holiday rota has been updated. Please log in to check your shifts"
.Display
End With
Set oOLapp = Nothing
Set oMailItem = Nothing
End Sub

Hi what code have you got so far. Ill help yo amend it to what you need

 

[paulxmw]

try
Sub EmailActiveTaskManagers()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim ws As Worksheet



Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")


On Error GoTo cleanup
For Each cell In Column("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.row, "C").Value) = "active" Then


Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.value
.BCC = " "
.Subject = "**** Rota Update ****"
.HTMLBody = "Hello. Please note that the holiday rota has been updated. Please log in to check your shifts"
.Display 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell


cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

 

[surkdidat]

Hi

I have put this code in and the an error is coming up:
Compile error : Sub or Function not defined

(When OK is clicked, its bringing up the highlight on "For each cell In Column("B")

try
Sub EmailActiveTaskManagers()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim ws As Worksheet



Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")


On Error GoTo cleanup
For Each cell In Column("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.row, "C").Value) = "active" Then


Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.value
.BCC = " "
.Subject = "**** Rota Update ****"
.HTMLBody = "Hello. Please note that the holiday rota has been updated. Please log in to check your shifts"
.Display 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell


cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub