email by rows

[DaleL]

hello All:

I'm looking for a macro that will go down a sheet and look for th
email address and mail every thing in that row to *ONLY* that person n
matter if it has 10 columns or 20 columns I have a sheet set up lik
this
Employee Name LAB Degree Section E-Mail Address paper1 paper2
paper3

I will be adding more columns as the year goes on that is why it nee
to be able to send different size rows.

Any help would be appreciated

Dal

 

[Ron de Bruin]

Hi DaleL

Which mail program do you use

 

[DaleL]

Ihave outlook and also outlook express installed and running, also hav
raiden mail system that is used for smtp.
I use one of your scripts now Ron your site was passed on to me b
CSmith from pennysaver. I use the one that has column A=email B=nam
C=yes/no if i could only get that script to send every thing else i
the same row it would be great

Dal

 

[Ron de Bruin]

Hi Dale

Try this

This example will send 20 columns of the row.
If you want more change this line in the function
Source:=Range(Cells(cell.Row, 1), Cells(cell.Row, 20)).Address, _

This will send 50 columns and not A:C for example
Source:=Range(Cells(cell.Row, 4), Cells(cell.Row, 50)).Address, _


Option Explicit
Dim cell As Range

Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value <> "" Then
If cell.Value Like "*@*" And cell.Offset(0, 1).Value = "yes" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "Reminder"
.HTMLBody = RangetoHTML
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


Function RangetoHTML()
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
Source:=Range(Cells(cell.Row, 1), Cells(cell.Row, 20)).Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function

 

[DaleL]

I copied the script from here in to module1
and checked Microsoft outlook 9.0 object libary
when i run the code nothing happens i have my email adress in column B

DaleL

 

[Ron de Bruin]

Hi

and checked Microsoft outlook 9.0 object libary

You don't have to set a reference,I use Late binding

Change
Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)

To
Columns("B").Cells.SpecialCells(xlCellTypeConstants)

And be sure the sheet with the email adress in column B is active

***Dim cell As Range***
must be above the sub and function

 

[DaleL]

it works if i want to have email adress in row E can i just change
to E ??

also every email that goes out I have to click yes for outlook to sen
it.
Is there a way to get past it?? With sending several hundred emai
every day that would get old fast ??

Dale

 

[Ron de Bruin]

Hi Dale

it works if i want to have email adress in row E can i just change B
to E ??

Yes, if yes/no is in F

Is there a way to get past it?? With sending several hundred email
every day that would get old fast ??

Look here
http://www.rondebruin.nl/mail/prevent.htm

CDO is maybe a option for you

 

[DaleL]

*Hi Dale


Yes, if yes/no is in F

Thanks agian this so far is the best I have gotten I have a work boo
that has a few other bulit in features I would like to have thi
added to..kinda like an automated grade book im trying to make fo
teachers where I work at.
Would you be willing to look at it off this list and try to help m
out with some of the email functions??
If your busy that is fine to..



Look here
http://www.rondebruin.nl/mail/prevent.htm

CDO is maybe a option for you

 

[DaleL]

* *

Is there any way to get the headers to go with this so when the mai
goes out it kinda helps to know what it is your looking at

Name Email Yes/No paper1 paper2 paper3 paper4 paper5 paper6

can this be down with this macro ?

 

[DaleL]

im using this script to send the rows one at a time by email..But I als
want to include the headers also. How can I add that to this script s
every email has headers from the sheet and the data under it only fro
the row being sent ??



origanal script from Ron de Bruin

This example will send 20 columns of the row.
If you want more change this line in the function
Source:=Range(Cells(cell.Row, 1), Cells(cell.Row, 20)).Address, _

This will send 50 columns and not A:C for example
Source:=Range(Cells(cell.Row, 4), Cells(cell.Row, 50)).Address, _


Option Explicit
Dim cell As Range

Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell I
Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value <> "" Then
If cell.Value Like "*@*" And cell.Offset(0, 1).Value = "yes" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "Reminder"
.HTMLBody = RangetoHTML
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


Function RangetoHTML()
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
Source:=Range(Cells(cell.Row, 1), Cells(cell.Row, 20)).Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Functio

 

[Ron de Bruin]

Hi Dale

You can filter on each name and send the visible cells in the range.
If you want a example I will make one for you this weekend.

Let me know if you want that

 

[DaleL]

yes please make an example for me. I need all the help I can get I'm no
very experienced with excel.
If you would please use the original mail code you gave me so I can cu
and paste it in to the macro.

Thanks
Dale

 

[Ron de Bruin]

Hi Dale

I add this page to my site today
http://www.rondebruin.nl/mail/folder3/row.htm

It is a example for Outlook
I hope you can use it

 

[DaleL]

Ron thanks this will help me out a lot i am trying to make a work boo
for teachers to help automate a lot of grading functions they have t
do and this will be a great add in for it

Dale

*Hi Dale

I add this page to my site today
http://www.rondebruin.nl/mail/folder3/row.htm

It is a example for Outlook
I hope you can use it

--
Regards Ron de Bruin
http://www.rondebruin.nl

yes please make an example for me. I need all the help I can ge I'm not
very experienced with excel.
If you would please use the original mail code you gave me so I ca cut
and paste it in to the macro.

Thanks
Dale

 

[Ron de Bruin]

Hi Dale
check out also this

A lot of teachers use one sheet for each student and mail that one
http://www.rondebruin.nl/mail/folder1/mail5.htm

Or for Outlook
http://www.rondebruin.nl/mail/folder2/mail5.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl

Ron thanks this will help me out a lot i am trying to make a work book
for teachers to help automate a lot of grading functions they have to
do and this will be a great add in for it

Dale

*Hi Dale

I add this page to my site today
http://www.rondebruin.nl/mail/folder3/row.htm

It is a example for Outlook
I hope you can use it

 

[DaleL]

is this where I change it (Ash.Range("A1:J100") if i want to go all th
way over to column U can i just change :J to :U and if i want to NO
include say the first few coulmns would i do (Ash.Range("E1:U100") i
this correct or am i not reading this correctly

DaleL

*Hi Dale
check out also this

A lot of teachers use one sheet for each student and mail that one
http://www.rondebruin.nl/mail/folder1/mail5.htm

Or for Outlook
http://www.rondebruin.nl/mail/folder2/mail5.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl

Ron thanks this will help me out a lot i am trying to make a wor book
for teachers to help automate a lot of grading functions they hav to
do and this will be a great add in for it

Dale

 

[Ron de Bruin]

Hi

In this example you can change the J to U
But A must stay A


--
Regards Ron de Bruin
http://www.rondebruin.nl

is this where I change it (Ash.Range("A1:J100") if i want to go all the
way over to column U can i just change :J to :U and if i want to NOT
include say the first few coulmns would i do (Ash.Range("E1:U100") is
this correct or am i not reading this correctly

DaleL

*Hi Dale
check out also this

A lot of teachers use one sheet for each student and mail that one
http://www.rondebruin.nl/mail/folder1/mail5.htm

Or for Outlook
http://www.rondebruin.nl/mail/folder2/mail5.htm

 

[Ron de Bruin]

You can add this to the sub if you not want to send A:C

After this existing line rng.Copy Nsh.Cells(1)
copy this line

Nsh.Columns("A:C").Delete


--
Regards Ron de Bruin
http://www.rondebruin.nl

Hi

In this example you can change the J to U
But A must stay A


--
Regards Ron de Bruin
http://www.rondebruin.nl

is this where I change it (Ash.Range("A1:J100") if i want to go all the
way over to column U can i just change :J to :U and if i want to NOT
include say the first few coulmns would i do (Ash.Range("E1:U100") is
this correct or am i not reading this correctly

DaleL

*Hi Dale
check out also this

A lot of teachers use one sheet for each student and mail that one
http://www.rondebruin.nl/mail/folder1/mail5.htm

Or for Outlook
http://www.rondebruin.nl/mail/folder2/mail5.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl


Ron thanks this will help me out a lot i am trying to make a work
book
for teachers to help automate a lot of grading functions they have
to
do and this will be a great add in for it

Dale

 

[DaleL]

HI Ron I added your code to my workbook and it is giveing me errors a
.Publish (True)when I click the debug button this is where the yello
line is..Publish (True)

it works part of the time .. when it does work all it will send is th
headers..i dont know what im doing diffrently to get to work thos
times

This is the code I am using is it possable I can send my work book t
you and have you look it over and maybe try the code out your self ???

Dim Nsh As Worksheet

Sub Send_Row()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim rng As Range
Dim Ash As Worksheet

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set Ash = ActiveSheet
Set Nsh = Worksheets.Add
Ash.Activate

On Error GoTo cleanup
For Each cell I
Ash.Columns("E").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" And cell.Offset(0, 1).Value = "yes
Then
Ash.Range("A1:L100").AutoFilter Field:=2
Criteria1:=cell.Value
With Ash.AutoFilter.Range
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
rng.Copy Nsh.Cells(1)
Nsh.Columns.AutoFit
Ash.AutoFilterMode = False

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "Grades Aug"
.HTMLBody = RangetoHTML2
.Send 'Or use Display
End With
Set OutMail = Nothing
Nsh.Cells.Clear
End If
Next cell

cleanup:
Application.DisplayAlerts = False
Nsh.Delete
Application.DisplayAlerts = True
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub




Function RangetoHTML2()
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=Nsh.Name, _
Source:=Nsh.UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML2 = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Functio