ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   mailing (https://www.excelbanter.com/excel-programming/344552-mailing.html)

ceemo[_46_]

mailing
 

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

i would like a way to string all the mail addresses togther so it woul
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 Exi
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 Su

--
ceem
-----------------------------------------------------------------------
ceemo's Profile: http://www.excelforum.com/member.php...fo&userid=1065
View this thread: http://www.excelforum.com/showthread.php?threadid=48098



All times are GMT +1. The time now is 03:34 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com