Hi there, and welcome to the forum.
The following code should go in a standard module in your workbook (let me know if you need help placing that):
Code:
Sub SendAlerts()
Dim nm As Name
Dim sArea As String
Dim sRecipients As String
Dim sMsg As String
Dim cl As Range
Dim rngTable As Range
'Capture key details
With Worksheets("Sheet 1")
sArea = .Range("B4")
sMsg = .Range("C4")
End With
'Determine range to search for emails
With Worksheets("Sheet 2")
Set rngTable = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
'Get list of recipients
For Each cl In rngTable
If cl.Value = sArea Then
sRecipients = sRecipients & cl.Offset(0, 1).Value & " (" & cl.Offset(0, 2).Value & ");"
End If
Next cl
'Check if any recipients found
If Len(sRecipients) > 0 Then
sRecipients = Left(sRecipients, Len(sRecipients) - 1)
'Send the email
Call SendEmail(sRecipients, "SMS", sMsg)
Else
MsgBox "Sorry, no recipients found!"
End If
End Sub
Sub SendEmail(sRecipients As String, sSubject As String, sBody As String)
'Macro Purpose: To send an email through Outlook
Dim objOL As Object
Dim objMail As Object
'Turn on error handling
On Error GoTo Cleanup
'Bind to Outlook
Set objOL = CreateObject("Outlook.Application")
'Create a new email and send it
Set objMail = objOL.CreateItem(0) '0=olmailitem
With objMail
.To = sRecipients
.Subject = sSubject
.Body = sBody
.Display
End With
Cleanup:
'Release all objects
Set objMail = Nothing
Set objOL = Nothing
On Error GoTo 0
End Sub
You should then be able to link your button to the "SendAlerts" macro.
Once you're happy that it is working, change the line in the second routine from .Display to .Send and it will send automatically without previewing first.
Bookmarks