ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Used to work now it doesnt (https://www.excelbanter.com/excel-programming/435235-used-work-now-doesnt.html)

Rpettis31

Used to work now it doesnt
 
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 x:publishsource=", _
"align=left x:publishsource=")

'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





[email protected]

Used to work now it doesnt
 
Hi
Which is the bit of code which sends the file?
regards
Paul

On Oct 21, 1:27*pm, Rpettis31
wrote:
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 x:publishsource=", _
* * * * * * * * * * * * * * * "align=left x:publishsource=")

* * * * '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



Patrick Molloy[_2_]

Used to work now it doesnt
 
did you step through the code & see the data being copied? Did the htm file
get created? were there any errors?

"Rpettis31" wrote:

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 x:publishsource=", _
"align=left x:publishsource=")

'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





Rpettis31

Used to work now it doesnt
 
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" wrote:

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

"Rpettis31" wrote:

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 x:publishsource=", _
"align=left x:publishsource=")

'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





Patrick Molloy[_2_]

Used to work now it doesnt
 
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" wrote:

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" wrote:

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

"Rpettis31" wrote:

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 x:publishsource=", _
"align=left x:publishsource=")

'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





Rpettis31

Used to work now it doesnt
 
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 =
@unieki "
'.CC =
;Von ;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

"Patrick Molloy" wrote:

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" wrote:

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" wrote:

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

"Rpettis31" wrote:

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 x:publishsource=", _
"align=left x:publishsource=")

'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






All times are GMT +1. The time now is 10:14 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com