Used to work now it doesnt

[Rpettis31]

I have a report that automatically sends and email and updates some files to
a user group. However this morning when it ran the email is blank and I am
left with a temp sheet2 that was supposed to be emailed. I have changed
nothing in the code. So I am perplexed as to why this is happening.

Here is my function.
Function RangetoHTML(rng As Range)
' Revised/Modified by Robert Pettis 3-04-08
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss")
& ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Range("a1:n50").Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")

'Close TempWB
TempWB.Close SaveChanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

 

[paul.robinson]

Hi
Which is the bit of code which sends the file?
regards
Paul

 

[Patrick Molloy]

did you step through the code & see the data being copied? Did the htm file
get created? were there any errors?

 

[Rpettis31]

The file is being created but apparently is not read into the rangetohtml.
as the outlook prompt comes up and the email sends without the body of the
email.
The file also is not killed. I have this code in other files and it works
fine.

 

[Patrick Molloy]

stepping through your code it worked fien & produced teh text correctly.
this line
.Range("a1:n50").Select
is not needed at all

I don't see the code that calls this function , so I can't see why it isn't
added toy your mail

I expect to see somthing akin to

WITH {mail object}
.TO {blah}
..HTML = RangeToHTML({source range})

..Display ' instead of .SEND
END WITH

 

[Rpettis31]

Here is the mail code this works for whatever reason the range to html is not
being read so a blank email is sending.
Sub Mail_Selection_Range_Outlook_Body()
' Send PO issues list via email
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Sheets("Sheet1").Range("a1:n175")

On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected"
& _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "rep"
'.To =
"tkh;[email protected];[email protected];[email protected]"
'.CC =
"rep;rsk;rwf;rjg;jmb1;[email protected];[email protected];jcj"
.BCC = ""
.Subject = "Hot Container list"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub