Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel 2010 Sendmail .Display works, but not .Send --- Please help
Hello-
I have posted the code I am using below (from Ron DeBruin's SendMail examples). When we went to Office 2010, a number of spreadsheets that send through Outlook no longer worked, so I found this code which should work in Office 2010. I can get an email to generate using .Display, but if I change the line to .Send the code will finish with no email created and sent. I'm at a loss as to why this would happen. Here is my code, I have it set up to email a selection in the body of the Outlook message. Sub SendStats() ' Don't forget to copy the function RangetoHTML in the module. ' Working in Office 2000-2010 Dim rng As Range Dim OutApp As Object Dim OutMail As Object Dim Rep As Range Dim Subject As Range With Application .EnableEvents = False .ScreenUpdating = False End With Set rng = Nothing On Error Resume Next Set rng = Sheets("Stats").Range("A1:O10").SpecialCells(xlCel lTypeVisible) 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 Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Set Rep = Sheets("Stats").Range("C14") Set Subject = Sheets("Stats").Range("A3") On Error Resume Next With OutMail .To = Rep.Value .CC = "" .BCC = "" .Subject = "Rep Stats for" & " " & Subject.Value .HTMLBody = RangetoHTML(rng) .Send End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing End Sub Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2010 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 .Cells(1).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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel 2010 Sendmail .Display works, but not .Send --- Pleasehelp
hi,
i put my mail address in cell C14 of a sheet named "Stats" and execute this code, it works fine on my pc (win7, office 14) isabelle Le 2013-02-15 18:33, Sabosis a écrit : Hello- I have posted the code I am using below (from Ron DeBruin's SendMail examples). When we went to Office 2010, a number of spreadsheets that send through Outlook no longer worked, so I found this code which should work in Office 2010. I can get an email to generate using .Display, but if I change the line to .Send the code will finish with no email created and sent. I'm at a loss as to why this would happen. Here is my code, I have it set up to email a selection in the body of the Outlook message. Sub SendStats() ' Don't forget to copy the function RangetoHTML in the module. ' Working in Office 2000-2010 Dim rng As Range Dim OutApp As Object Dim OutMail As Object Dim Rep As Range Dim Subject As Range With Application .EnableEvents = False .ScreenUpdating = False End With Set rng = Nothing On Error Resume Next Set rng = Sheets("Stats").Range("A1:O10").SpecialCells(xlCel lTypeVisible) 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 Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Set Rep = Sheets("Stats").Range("C14") Set Subject = Sheets("Stats").Range("A3") On Error Resume Next With OutMail .To = Rep.Value .CC = "" .BCC = "" .Subject = "Rep Stats for" & " " & Subject.Value .HTMLBody = RangetoHTML(rng) .Send End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing End Sub Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2010 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 .Cells(1).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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel 2010 Sendmail .Display works, but not .Send --- Please help
On Sunday, February 17, 2013 4:33:37 PM UTC-8, isabelle wrote:
hi, i put my mail address in cell C14 of a sheet named "Stats" and execute this code, it works fine on my pc (win7, office 14) isabelle Le 2013-02-15 18:33, Sabosis a écrit : Hello- I have posted the code I am using below (from Ron DeBruin's SendMail examples). When we went to Office 2010, a number of spreadsheets that send through Outlook no longer worked, so I found this code which should work in Office 2010. I can get an email to generate using .Display, but if I change the line to .Send the code will finish with no email created and sent. I'm at a loss as to why this would happen. Here is my code, I have it set up to email a selection in the body of the Outlook message. Sub SendStats() ' Don't forget to copy the function RangetoHTML in the module. ' Working in Office 2000-2010 Dim rng As Range Dim OutApp As Object Dim OutMail As Object Dim Rep As Range Dim Subject As Range With Application .EnableEvents = False .ScreenUpdating = False End With Set rng = Nothing On Error Resume Next Set rng = Sheets("Stats").Range("A1:O10").SpecialCells(xlCel lTypeVisible) 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 Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Set Rep = Sheets("Stats").Range("C14") Set Subject = Sheets("Stats").Range("A3") On Error Resume Next With OutMail .To = Rep.Value .CC = "" .BCC = "" .Subject = "Rep Stats for" & " " & Subject.Value .HTMLBody = RangetoHTML(rng) .Send End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing End Sub Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2010 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 .Cells(1).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 Are there any ideas why this would not work on a machine running Win 7 & Office 10? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
not enough resources to display completely starting excel 2010 | Excel Discussion (Misc queries) | |||
Sendmail works one computer, not another | Excel Programming | |||
Excel VBA using Sendmail to Send to Distribution List | Excel Programming | |||
sendmail works in excel 2002 but not 2000 | Excel Programming | |||
Problems with SendMail or automation of Send To | Excel Programming |