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(xlCellTypeCons tants)
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

--
tcooper00
-----------------------------------------------------------------------
tcooper007's Profile: http://www.excelforum.com/member.php...fo&userid=3019
View this thread: http://www.excelforum.com/showthread.php?threadid=49879

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/sen...s_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

Hi tcooper007

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

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


"tcooper007" wrote in message
...

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

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

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

When the instruction states that I need to post the script in normal
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 this
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 In
Ash.Columns("B").Cells.SpecialCells(xlCellTypeCons tants)
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 and
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 Function


--
tcooper007
------------------------------------------------------------------------
tcooper007's Profile: http://www.excelforum.com/member.php...o&userid=30194
View this thread: http://www.excelforum.com/showthread...hreadid=498794

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

--
tcooper00
-----------------------------------------------------------------------
tcooper007's Profile: http://www.excelforum.com/member.php...fo&userid=3019
View this thread: http://www.excelforum.com/showthread.php?threadid=49879

Ron-
Just sent it.

Thanks!!!!


--
tcooper007
------------------------------------------------------------------------
tcooper007's Profile: http://www.excelforum.com/member.php...o&userid=30194
View this thread: http://www.excelforum.com/showthread...hreadid=498794

Hi

I send you the testfile back with a few changes

I copy the macro and function in a normal module
(InsertModule in the VBA)

And use this in the sheet module to call the macro

Private Sub CommandButton1_Click()
Call Mailtest
End Sub


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


"tcooper007" wrote in message
...

Ron-
Just sent it.

Thanks!!!!


--
tcooper007
------------------------------------------------------------------------
tcooper007's Profile: http://www.excelforum.com/member.php...o&userid=30194
View this thread: http://www.excelforum.com/showthread...hreadid=498794

Great job Ron.
Thanks again!


--
tcooper007
------------------------------------------------------------------------
tcooper007's Profile: http://www.excelforum.com/member.php...o&userid=30194
View this thread: http://www.excelforum.com/showthread...hreadid=498794

Great job Ron.
Thanks again!


--
tcooper007
------------------------------------------------------------------------
tcooper007's Profile: http://www.excelforum.com/member.php...o&userid=30194
View this thread: http://www.excelforum.com/showthread...hreadid=498794