send e-mail automaticaly

  • Thread starter Thread starter yami-s
  • Start date Start date
Y

yami-s

Hi,
I have parmaters sheet which contains 2 lists of names and e-mail.
I also have database sheet,.
How can i automaticlly, by clicking abutton filter the data bas
according to the names which are on the list and send each name it
portion of the database
10x
Yam
 
Hi Yami

Do you want to send a workbook or in the body of the mail?
Which mail program you use?
 
It can be either way, in the body or as file, which ever is easier.
I use microsoft outloo
 
Try this one
Copy it all in a normal module

Sheet1
column A = names
column B = e-mail addresses

Sheet2 = your data sheet
It will filter the first two columns and the names in this example are in
column A


Public cell As Range

Sub tester()
For Each cell In ThisWorkbook.Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
ThisWorkbook.Sheets("Sheet2").Columns("A:B").AutoFilter Field:=1, Criteria1:=cell.Offset(0, -1).Value
'call macro
Mail_Range
End If
Next
ThisWorkbook.Sheets("Sheet2").AutoFilterMode = False
End Sub

Sub Mail_Range()
Dim source As Range
Dim dest As Workbook
Dim strdate As String

Set source = Nothing
On Error Resume Next
Set source = ThisWorkbook.Sheets("Sheet2").Cells.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The source is not a range or the sheet is protect, please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With

strdate = Format(Now, "dd-mm-yy h-mm-ss")
With dest
.SaveAs "Selection of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail cell.Value, _
"This is the Subject line"
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
End Sub
 
10x it works great,
just one question, when can we add the table header to the copied
data?

and again thanks, 10x
Yami
 
Hi yami

If you have a header in the first row then it will copy also to the new sheet

In the sub tester you can also set screenupdating to false so you don't see the
screen flicker.
 
Back
Top