Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code problem emailing range as html in Outlook body
I am at a loss as to why the code below crashes when it gets to the
".publish" line in the function. This code is a modification of coding from Ron de Bruin's site (Thanks Ron!). I have inserted range names, etc. as needed to fit the workbook I am coding. I will let you all know that I am a "Novice" in every sense of the word, so I would greatly appreciate any assistance in solving this problem. Please ignore any debris in the middle of the code; I was trying ideas I could find. Thanks in a advance. Alan Private Sub CommandButton2_Click() 'Sub Mail_Selection_Outlook_Body() 'You must add a reference to the Microsoft outlook Library'Is not working in Office 97 Dim source As Range Dim dest As Workbook Dim myshape As Shape Dim OutApp As Object Dim OutMail As Object 'Dim OutApp As Outlook.Application 'Dim OutMail As Outlook.MailItem Set source = Nothing On Error Resume Next Set source = ActiveWorkbook.ActiveSheet.Range("Print_Form") ' Selection.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If source Is Nothing Then MsgBox "The selection is not a range or the sheet is protect" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If 'If ActiveWindow.SelectedSheets.Count 1 Or _ ' Selection.Cells.Count = 1 Or _ ' Selection.Areas.Count 1 Then ' MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _ ' "You have more than one sheet selected." & vbNewLine & _ ' "You only selected one cell." & vbNewLine & _ ' "You selected more than one area." & vbNewLine & vbNewLine & _ ' "Please correct and try again.", vbOKOnly ' Exit Sub 'End If Application.ScreenUpdating = False ActiveSheet.Copy Set dest = ActiveWorkbook For Each myshape In dest.Sheets(1).Shapes myshape.Delete Next Set OutApp = CreateObject("Outlook.Application") 'Set OutMail = OutApp.CreateItem(olMailItem) Set OutMail = OutApp.CreateItem(0) With OutMail .To = "" .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML() 'CreateWebPage() '.Send 'or use .Display End With 'dest.Close = False Set OutMail = Nothing Set OutApp = Nothing Set dest = Nothing Application.ScreenUpdating = True End Sub Public Function RangetoHTML() ' You can't use this function in Excel 97 Dim fso As Object Dim ts As Object Dim TempFile As String Dim filename As String 'Dim sam As Object Set wks = ActiveWorkbook.ActiveSheet TempFile = Environ$("temp") & "vouch_tmp.htm" 'Dim filename As String, sam As Object 'Dim Rng As Range 'Set Rgn = "Print_Form" 'TempFile = "C:\Temp\" & "vouch_tmp.htm" 'Format(Now, "dd-mm-yy h-mm-ss") & ".htm" With ActiveWorkbook.PublishObjects.Add( _ xlSourceRange, _ TempFile, _ wks.Name, _ "Print_Form", _ xlHtmlStatic) .Publish True End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close Set ts = Nothing Set fso = Nothing Kill TempFile End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code problem emailing range as html in Outlook body
Hi Alan
Try this Sub Mail_Selection_Outlook_Body() 'Is not working in Office 97 Dim source As Range Dim dest As Workbook Dim myshape As Shape Dim OutApp As Object Dim OutMail As Object Set source = Nothing On Error Resume Next Set source = Range("Print_Form").SpecialCells(xlCellTypeVisible ) On Error GoTo 0 If source Is Nothing Then MsgBox "The selection is not a range or the sheet is protect" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If Application.ScreenUpdating = False ActiveSheet.Copy Set dest = ActiveWorkbook For Each myshape In dest.Sheets(1).Shapes myshape.Delete Next Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = " .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML .send 'or use .Display End With dest.Close False Set OutMail = Nothing Set OutApp = Nothing Set dest = Nothing Application.ScreenUpdating = True End Sub Function RangetoHTML() 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:=Range("Print_Form").Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close Set ts = Nothing Set fso = Nothing Kill TempFile End Function -- Regards Ron de Bruin http://www.rondebruin.nl "Alan Campbell" wrote in message om... I am at a loss as to why the code below crashes when it gets to the ".publish" line in the function. This code is a modification of coding from Ron de Bruin's site (Thanks Ron!). I have inserted range names, etc. as needed to fit the workbook I am coding. I will let you all know that I am a "Novice" in every sense of the word, so I would greatly appreciate any assistance in solving this problem. Please ignore any debris in the middle of the code; I was trying ideas I could find. Thanks in a advance. Alan Private Sub CommandButton2_Click() 'Sub Mail_Selection_Outlook_Body() 'You must add a reference to the Microsoft outlook Library'Is not working in Office 97 Dim source As Range Dim dest As Workbook Dim myshape As Shape Dim OutApp As Object Dim OutMail As Object 'Dim OutApp As Outlook.Application 'Dim OutMail As Outlook.MailItem Set source = Nothing On Error Resume Next Set source = ActiveWorkbook.ActiveSheet.Range("Print_Form") ' Selection.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If source Is Nothing Then MsgBox "The selection is not a range or the sheet is protect" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If 'If ActiveWindow.SelectedSheets.Count 1 Or _ ' Selection.Cells.Count = 1 Or _ ' Selection.Areas.Count 1 Then ' MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _ ' "You have more than one sheet selected." & vbNewLine & _ ' "You only selected one cell." & vbNewLine & _ ' "You selected more than one area." & vbNewLine & vbNewLine & _ ' "Please correct and try again.", vbOKOnly ' Exit Sub 'End If Application.ScreenUpdating = False ActiveSheet.Copy Set dest = ActiveWorkbook For Each myshape In dest.Sheets(1).Shapes myshape.Delete Next Set OutApp = CreateObject("Outlook.Application") 'Set OutMail = OutApp.CreateItem(olMailItem) Set OutMail = OutApp.CreateItem(0) With OutMail .To = "" .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML() 'CreateWebPage() '.Send 'or use .Display End With 'dest.Close = False Set OutMail = Nothing Set OutApp = Nothing Set dest = Nothing Application.ScreenUpdating = True End Sub Public Function RangetoHTML() ' You can't use this function in Excel 97 Dim fso As Object Dim ts As Object Dim TempFile As String Dim filename As String 'Dim sam As Object Set wks = ActiveWorkbook.ActiveSheet TempFile = Environ$("temp") & "vouch_tmp.htm" 'Dim filename As String, sam As Object 'Dim Rng As Range 'Set Rgn = "Print_Form" 'TempFile = "C:\Temp\" & "vouch_tmp.htm" 'Format(Now, "dd-mm-yy h-mm-ss") & ".htm" With ActiveWorkbook.PublishObjects.Add( _ xlSourceRange, _ TempFile, _ wks.Name, _ "Print_Form", _ xlHtmlStatic) .Publish True End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close Set ts = Nothing Set fso = Nothing Kill TempFile End Function |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code problem emailing range as html in Outlook body
Ron,
Worked like a charm. Thanks for your help. I looked over the differences rather quickly. Was the problem in my "set source" line? Thanks again. Alan "Ron de Bruin" wrote in message ... Hi Alan Try this Sub Mail_Selection_Outlook_Body() 'Is not working in Office 97 Dim source As Range Dim dest As Workbook Dim myshape As Shape Dim OutApp As Object Dim OutMail As Object Set source = Nothing On Error Resume Next Set source = Range("Print_Form").SpecialCells(xlCellTypeVisible ) On Error GoTo 0 If source Is Nothing Then MsgBox "The selection is not a range or the sheet is protect" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If Application.ScreenUpdating = False ActiveSheet.Copy Set dest = ActiveWorkbook For Each myshape In dest.Sheets(1).Shapes myshape.Delete Next Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = " .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML .send 'or use .Display End With dest.Close False Set OutMail = Nothing Set OutApp = Nothing Set dest = Nothing Application.ScreenUpdating = True End Sub Function RangetoHTML() 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:=Range("Print_Form").Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close Set ts = Nothing Set fso = Nothing Kill TempFile End Function -- Regards Ron de Bruin http://www.rondebruin.nl "Alan Campbell" wrote in message om... I am at a loss as to why the code below crashes when it gets to the ".publish" line in the function. This code is a modification of coding from Ron de Bruin's site (Thanks Ron!). I have inserted range names, etc. as needed to fit the workbook I am coding. I will let you all know that I am a "Novice" in every sense of the word, so I would greatly appreciate any assistance in solving this problem. Please ignore any debris in the middle of the code; I was trying ideas I could find. Thanks in a advance. Alan Private Sub CommandButton2_Click() 'Sub Mail_Selection_Outlook_Body() 'You must add a reference to the Microsoft outlook Library'Is not working in Office 97 Dim source As Range Dim dest As Workbook Dim myshape As Shape Dim OutApp As Object Dim OutMail As Object 'Dim OutApp As Outlook.Application 'Dim OutMail As Outlook.MailItem Set source = Nothing On Error Resume Next Set source = ActiveWorkbook.ActiveSheet.Range("Print_Form") ' Selection.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If source Is Nothing Then MsgBox "The selection is not a range or the sheet is protect" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If 'If ActiveWindow.SelectedSheets.Count 1 Or _ ' Selection.Cells.Count = 1 Or _ ' Selection.Areas.Count 1 Then ' MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _ ' "You have more than one sheet selected." & vbNewLine & _ ' "You only selected one cell." & vbNewLine & _ ' "You selected more than one area." & vbNewLine & vbNewLine & _ ' "Please correct and try again.", vbOKOnly ' Exit Sub 'End If Application.ScreenUpdating = False ActiveSheet.Copy Set dest = ActiveWorkbook For Each myshape In dest.Sheets(1).Shapes myshape.Delete Next Set OutApp = CreateObject("Outlook.Application") 'Set OutMail = OutApp.CreateItem(olMailItem) Set OutMail = OutApp.CreateItem(0) With OutMail .To = "" .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML() 'CreateWebPage() '.Send 'or use .Display End With 'dest.Close = False Set OutMail = Nothing Set OutApp = Nothing Set dest = Nothing Application.ScreenUpdating = True End Sub Public Function RangetoHTML() ' You can't use this function in Excel 97 Dim fso As Object Dim ts As Object Dim TempFile As String Dim filename As String 'Dim sam As Object Set wks = ActiveWorkbook.ActiveSheet TempFile = Environ$("temp") & "vouch_tmp.htm" 'Dim filename As String, sam As Object 'Dim Rng As Range 'Set Rgn = "Print_Form" 'TempFile = "C:\Temp\" & "vouch_tmp.htm" 'Format(Now, "dd-mm-yy h-mm-ss") & ".htm" With ActiveWorkbook.PublishObjects.Add( _ xlSourceRange, _ TempFile, _ wks.Name, _ "Print_Form", _ xlHtmlStatic) .Publish True End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close Set ts = Nothing Set fso = Nothing Kill TempFile End Function |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code problem emailing range as html in Outlook body
Ron,
All is working well with the changes... generally. However, when the document gets embedded in to the email body, some of the cell data and formatting is missing. Any toughts?? Thanks again. Alan "Ron de Bruin" wrote in message ... Hi Alan The example on my site is for the selection In the original function on my site I use source:=Selection.Address In your situation you are not sending the selection but a named range. I changed this to Range("Print_Form").Address -- Regards Ron de Bruin http://www.rondebruin.nl "Alan Campbell" wrote in message om... Ron, Worked like a charm. Thanks for your help. I looked over the differences rather quickly. Was the problem in my "set source" line? Thanks again. Alan "Ron de Bruin" wrote in message ... Hi Alan Try this Sub Mail_Selection_Outlook_Body() 'Is not working in Office 97 Dim source As Range Dim dest As Workbook Dim myshape As Shape Dim OutApp As Object Dim OutMail As Object Set source = Nothing On Error Resume Next Set source = Range("Print_Form").SpecialCells(xlCellTypeVisible ) On Error GoTo 0 If source Is Nothing Then MsgBox "The selection is not a range or the sheet is protect" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If Application.ScreenUpdating = False ActiveSheet.Copy Set dest = ActiveWorkbook For Each myshape In dest.Sheets(1).Shapes myshape.Delete Next Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = " .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML .send 'or use .Display End With dest.Close False Set OutMail = Nothing Set OutApp = Nothing Set dest = Nothing Application.ScreenUpdating = True End Sub Function RangetoHTML() 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:=Range("Print_Form").Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close Set ts = Nothing Set fso = Nothing Kill TempFile End Function -- Regards Ron de Bruin http://www.rondebruin.nl "Alan Campbell" wrote in message om... I am at a loss as to why the code below crashes when it gets to the ".publish" line in the function. This code is a modification of coding from Ron de Bruin's site (Thanks Ron!). I have inserted range names, etc. as needed to fit the workbook I am coding. I will let you all know that I am a "Novice" in every sense of the word, so I would greatly appreciate any assistance in solving this problem. Please ignore any debris in the middle of the code; I was trying ideas I could find. Thanks in a advance. Alan Private Sub CommandButton2_Click() 'Sub Mail_Selection_Outlook_Body() 'You must add a reference to the Microsoft outlook Library'Is not working in Office 97 Dim source As Range Dim dest As Workbook Dim myshape As Shape Dim OutApp As Object Dim OutMail As Object 'Dim OutApp As Outlook.Application 'Dim OutMail As Outlook.MailItem Set source = Nothing On Error Resume Next Set source = ActiveWorkbook.ActiveSheet.Range("Print_Form") ' Selection.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If source Is Nothing Then MsgBox "The selection is not a range or the sheet is protect" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If 'If ActiveWindow.SelectedSheets.Count 1 Or _ ' Selection.Cells.Count = 1 Or _ ' Selection.Areas.Count 1 Then ' MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _ ' "You have more than one sheet selected." & vbNewLine & _ ' "You only selected one cell." & vbNewLine & _ ' "You selected more than one area." & vbNewLine & vbNewLine & _ ' "Please correct and try again.", vbOKOnly ' Exit Sub 'End If Application.ScreenUpdating = False ActiveSheet.Copy Set dest = ActiveWorkbook For Each myshape In dest.Sheets(1).Shapes myshape.Delete Next Set OutApp = CreateObject("Outlook.Application") 'Set OutMail = OutApp.CreateItem(olMailItem) Set OutMail = OutApp.CreateItem(0) With OutMail .To = "" .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML() 'CreateWebPage() '.Send 'or use .Display End With 'dest.Close = False Set OutMail = Nothing Set OutApp = Nothing Set dest = Nothing Application.ScreenUpdating = True End Sub Public Function RangetoHTML() ' You can't use this function in Excel 97 Dim fso As Object Dim ts As Object Dim TempFile As String Dim filename As String 'Dim sam As Object Set wks = ActiveWorkbook.ActiveSheet TempFile = Environ$("temp") & "vouch_tmp.htm" 'Dim filename As String, sam As Object 'Dim Rng As Range 'Set Rgn = "Print_Form" 'TempFile = "C:\Temp\" & "vouch_tmp.htm" 'Format(Now, "dd-mm-yy h-mm-ss") & ".htm" With ActiveWorkbook.PublishObjects.Add( _ xlSourceRange, _ TempFile, _ wks.Name, _ "Print_Form", _ xlHtmlStatic) .Publish True End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close Set ts = Nothing Set fso = Nothing Kill TempFile End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Send a Sheet as body of Outlook Email | Excel Discussion (Misc queries) | |||
Importing html documents into Excel adds rows to the body. | Excel Discussion (Misc queries) | |||
Emailing a template and keeping same layout as the message body | Excel Discussion (Misc queries) | |||
Literally displaying imported cells with and tags | Excel Discussion (Misc queries) | |||
Mail Worksheet as (html) message body | Excel Programming |