mailing

[ceemo]

I took some code from the tips section of this website and ive modified
it slightly to send selected dheets to a list of mail address in row
order rather than column order. However there is a prompt before
sending to each mail address ' A program is trying to auto send e-mail
on your behalf......'

i would like a way to string all the mail addresses togther so it would
only produce this msg once rather than for every mail address?


please can u help?




Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
For a = 1 To 253 Step 1
If ThisWorkbook.Sheets("mail").Cells(a, 2).Value = "" Then Exit
Sub
Application.ScreenUpdating = False
last = ThisWorkbook.Sheets("mail").Cells(Rows.Count,
1).End(xlUp).Row
N = 0
For shname = 1 To last
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname,
1).Value
Next shname
ThisWorkbook.Worksheets(Arr).Copy
strdate = Format(Date, "dd-mm-yy") & " " & Format(Time,
"h-mm-ss")
ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
With ThisWorkbook.Sheets("mail")
MyArr = .Range(.Cells(a, 2), .Cells(Rows.Count,
2).End(xlUp))
End With
ActiveWorkbook.SendMail MyArr,
ThisWorkbook.Sheets("mail").Cells(1, 3).Value
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Next a
End Sub