Using MailEnvelope

[davidsmithco]

All,

I have been using the following bit of code to have department managers send a daily report by simply clicking a button with an assigned macro (below red for the email portion.) The intent was to keep it simple and idiot-proof so that it would get done accurately and on time.

Sub Copy_email_file()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook

With Application
.Application.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With

If MsgBox("Do you want save and Email STAT?", vbOKCancel) = vbCancel Then Exit Sub

ActiveSheet.Range("A3:j37").Select

ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
.Item.To = "aaa@bbb.com"
.Item.Subject = ActiveWorkbook.ActiveSheet.Range("q1").Value
.Item.Send
End With

Set Sourcewb = ActiveWorkbook

With Destwb
ActiveWorkbook.SaveAs "s:\AccountingReports\Floor Stats" & "\" & ActiveWorkbook.ActiveSheet.Range("q1").Value & ".xlsm", FileFormat:=52

End With

With Destwb
ActiveWorkbook.Close
End With

With Application
.Application.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With

Several managers have asked me to allow them to add other names to the report before it is sent. What I would like to do then is to then is to define a range on the worksheet where they can add additional email addresses and the rest of the script will continue as before. Below is what I have done and it works for one cell reference. I do not know how to get it to work for multiple cell references though. (i.e. J14, J15, J16) I am sure I have to test for blank cells too!

ActiveSheet.Range("A3:L37").Select

ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
.Item.To = ActiveSheet.Range("J14").Value
.Item.Subject = ActiveWorkbook.ActiveSheet.Range("q1").Value
.Item.Send
End With

Thanks, Dave

 

[shg]

Maybe ...

  With wks.MailEnvelope
    ' ...
    For Each cell In Range("J15:J20")
        If Len(cell.Text) Then .Item.Recipients.Add cell.Text
    Next cell

 

[davidsmithco]

Thank you for the reply

I replaced this:

With ActiveSheet.MailEnvelope
.Item.To = aaa[EMAIL="aaa@bbb.com"]@bbb.com[/EMAIL]

with

With wks.MailEnvelope
' ...
For Each cell In Range("J15:J20")
If Len(cell.Text) Then .Item.Recipients.Add cell.Text
Next cell

and received this message:

Run-time error '424': Object required

I changed "With wks.MailEnvelope" to "With ActiveSheet.MailEnvelope" and then the script ran.

However the script only picked up the email address in 'J15' and ignored the email address I had in 'J16'

Suggestions?
Thanks, Dave