bloodmilksky
12-06-2016, 09:55 AM
Hi Guys,
I was just wondering if anyone knows of a way that I can use a macro to fire off a range of cells sheet 1 (F2-I36) and with the ability to have a pre written message in the email . I have the below but that only emails rows. any help would be greatly appreciated.
many thanks and all the best
Jamie
Sub EmailRanges()' Defines variables
Dim OutlookApp As Object, Mess As Object, SendAddress As String, Cell As Range, cRange As Range
' Disable screen updating
Application.ScreenUpdating = False
' Defines LastRow as the last row of column A containing data
LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
' Sets the range to check for email addresses
Set cRange = ActiveSheet.Range("B3")
' For each cell in the check range
For Each Cell In cRange
' If the cell is not blank then
If Cell.Value <> "" Then
' The desired send address will be the cell value
SendAddress = Cell.Value
' Select the range of cells on the active worksheet.
ActiveSheet.Range("C" & Cell.Row, "I" & Cell.Row).Select
' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True
' Set the optional introduction field thats adds
' some header text to the email body. It also sets
' the To and Subject lines. Finally the message
' is sent.
With ActiveSheet.MailEnvelope
.Introduction = "Good Morning"
.Item.To = SendAddress
.Item.Subject = "Just testing this macro sorry for filling you inbox ^_^ "
.Item.Send
End With
End If
' Check next cell in the check range
Next Cell
' Re-enable screen updating
Application.ScreenUpdating = True
MsgBox "The Customers Have Been Notified"
End Sub
I was just wondering if anyone knows of a way that I can use a macro to fire off a range of cells sheet 1 (F2-I36) and with the ability to have a pre written message in the email . I have the below but that only emails rows. any help would be greatly appreciated.
many thanks and all the best
Jamie
Sub EmailRanges()' Defines variables
Dim OutlookApp As Object, Mess As Object, SendAddress As String, Cell As Range, cRange As Range
' Disable screen updating
Application.ScreenUpdating = False
' Defines LastRow as the last row of column A containing data
LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
' Sets the range to check for email addresses
Set cRange = ActiveSheet.Range("B3")
' For each cell in the check range
For Each Cell In cRange
' If the cell is not blank then
If Cell.Value <> "" Then
' The desired send address will be the cell value
SendAddress = Cell.Value
' Select the range of cells on the active worksheet.
ActiveSheet.Range("C" & Cell.Row, "I" & Cell.Row).Select
' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True
' Set the optional introduction field thats adds
' some header text to the email body. It also sets
' the To and Subject lines. Finally the message
' is sent.
With ActiveSheet.MailEnvelope
.Introduction = "Good Morning"
.Item.To = SendAddress
.Item.Subject = "Just testing this macro sorry for filling you inbox ^_^ "
.Item.Send
End With
End If
' Check next cell in the check range
Next Cell
' Re-enable screen updating
Application.ScreenUpdating = True
MsgBox "The Customers Have Been Notified"
End Sub