Does anyone know how to Emails Ranges instead of Emailing Rows.

[bloodmilksky]

Hi Guys, I hope you are all well today

I have been using the below to fire off emails to customers. So their Account number appears in Column A & their email in Column B and it then sends off information row by row (C3:I3) to each customer.

What I was wondering if anyone knows how I may Amend this code to email named ranges instead of rows.

So the ranges would be A1:B10,C1:D10,E1:F10 and so on with their account number in A1 & email in B1 and information below.

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:B" & LastRow)


' 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

Any help would be greatly appreciated

Many thanks

Bloodmilksky

 

[Worf]

Here is what I understood:

• Email at B1 receives A1:B10
• Email at D1 receives C1:D10
• Email at F1 receives E1:F10

Sub EmailRanges()
Dim cr As Range
Set cr = [b1]
ActiveWorkbook.EnvelopeVisible = 1
Do While cr <> ""
    cr.Offset(, -1).Resize(10, 2).Select
    With ActiveSheet.MailEnvelope
        .Introduction = "Good Morning"
        .Item.To = cr
        .Item.Subject = "Just testing, sorry for filling you inbox ^_^ "
        ' .Item.Send
        .Item.Display
    End With
    MsgBox cr & " receives " & Selection.Address
    Set cr = cr.Offset(, 2)
Loop
Application.ScreenUpdating = True
MsgBox "The Customers Have Been Notified"
End Sub

 

[bloodmilksky]

Hi,

althought the macro is running through the ranges it isnt sending any of the emails.

 

[Worf]

Remove the display line and use the send command, which was commented out in the code for testing purposes.

 

[bloodmilksky]

now it is just offering a runtime error. here is what I have at the moment

Sub EmailRanges()Dim cr As Range
Set cr = [b1]
ActiveWorkbook.EnvelopeVisible = 1
Do While cr <> ""
    cr.Offset(, -1).Resize(30, 2).Select
    With ActiveSheet.MailEnvelope
        .Introduction = "Good Morning"
        .Item.To = cr
        .Item.Subject = "Just testing, sorry for filling you inbox ^_^ "
        .Item.Send
    End With
    Set cr = cr.Offset(, 2)
Loop
Application.ScreenUpdating = True
MsgBox "The Customers Have Been Notified"
End Sub

 

[Worf]

What line is highlighted? What’s the error number and message?

 

[bloodmilksky]

Hi,

END IF is being highlighted when I try and run the code. sorry for the delay in coming back to you

 Sub EmailRanges()Dim cr As Range
Set cr = [b1]


Do While cr <> ""
ActiveWorkbook.EnvelopeVisible = False
With ActiveSheet.MailEnvelope
cr.Offset(, -1).Resize(30, 2).Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
        .Introduction = " Good Morning"
        .Item.To = cr
        .Item.Subject = "Just testing, sorry for filling you inbox ^_^ "
        .Item.Send
    End With
    MsgBox cr & " receives " & Selection.Address
    Set cr = cr.Offset(, 2)
    
[U]End If[/U]


Loop
Application.ScreenUpdating = True
MsgBox "The Customers Have Been Notified"
End Sub

 

[Worf]

Like this:

Sub EmailRanges()
Dim cr As Range
Set cr = [b1]
ActiveWorkbook.EnvelopeVisible = True
Do While cr <> ""
    cr.Offset(, -1).Resize(30, 2).Select
    With ActiveSheet.MailEnvelope
        .Introduction = " Good Morning"
        .item.To = cr
        .item.Subject = "Just testing, sorry for filling you inbox ^_^ "
        '.item.Send                                 ' to send
        .item.Display                               ' to test
    End With
    MsgBox cr & " receives " & Selection.Address
    Set cr = cr.Offset(, 2)
Loop
Application.ScreenUpdating = True
MsgBox "The Customers Have Been Notified"
End Sub

 

[bloodmilksky]

Hi,

its sending the first range then coming up with a

"run time error" '-2147467259(80004005)':"
Method 'mailenvelope" of object'_Worksheet'failed

I can email you the workbook if it is any help.

could it be that it is just not possible to send these emails in the way that I am hoping.

 

[Worf]

Would you accept abandoning the mail envelope and using Outlook as shown below?

Mail Range/Selection in the body of the mail