Mail a row to each person in a range (HTML) - by Ron de Bruin

T

tcooper007

Hey guys.
First time posting here e and I am glad to see that Ron de Bruin post
here, because my question is in regards to his script :)

I have been trying to use the script that would email each row to
different person in the range… the link i
http://www.rondebruin.nl/mail/folder3/row.htm

I have tried, but the Outlook creates the email but does not post th
text in the body of the email. Truly, I am not sure why… as I am no
good with VBA.

When the instruction states that I need to post the script in norma
module, that means that I just need to open VBA and post it, right?

I have created a button to trigger the script, so this is what I have.

Any help would be appreciate, as I think the functionality of thi
script is tremendous.

Private Sub CommandButton1_Click()
' You must add a reference to the Microsoft outlook Library
' Don't forget to copy the function RangetoHTML2 in the module.
' Is not working in Office 97
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range
Dim rng As Range
Dim Ash As Worksheet
Dim Nsh As Worksheet
Set Ash = ActiveSheet
Set Nsh = Worksheets.Add
On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
Application.ScreenUpdating = False
For Each cell I
Ash.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0
1).Value) = "yes" Then
Ash.Range("A1:J100").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
With Nsh
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 an
higher
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Grades Aug"
.HTMLBody = RangetoHTML2
.Send 'Or use Display
End With
Set OutMail = Nothing
Nsh.Cells.Clear
Ash.AutoFilterMode = False
End If
Next cell
cleanup:
Application.DisplayAlerts = False
Nsh.Delete
Application.DisplayAlerts = True
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Public Function RangetoHTML2()
' You can't use this function in Excel 97
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:=ActiveSheet.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
 
N

Nate Oliver

Hello,

I'm not quite sure how your function would know what the range in
question is, at a glance. And with the way you've tabbed the code, or
lack thereof, that glance was trying...

You might be better off trying to use a single in-line procedure, e.g.,

http://www.danielklann.com/excel/sending_a_range_as_the_body.htm

The one thing I might add, would be to delete the temp. file once
you're done with it. You might use the Kill statement for this, but
I've had mixed results with this in the past..

I prefer to use the DeleteFile API function, never had a problem with
it. See the following:

http://www.mentalis.org/apilist/DeleteFile.shtml

Regards,
Nate Oliver
 
R

Ron de Bruin

Hi tcooper007

Send me your test workbook with the code and I look at it for you
 
T

tcooper007

Thanks.

Do you know of any script that can send each row to a differen
person?

I don't know how I would tell the script you sent me to send each ro
to a different email address...
I have some 100 different rows to send... and having to specify th
range each time is too much work.

Sorry about the lack of knowledge here..
Any help would be appreciated.

Thanks
 
R

Ron de Bruin

Hi

I send you the testfile back with a few changes

I copy the macro and function in a normal module
(Insert>Module in the VBA)

And use this in the sheet module to call the macro

Private Sub CommandButton1_Click()
Call Mailtest
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top