Sending ONLY Range or Page x, BUT not entire Activesheet, How ?
Ron,
Just found i am getting an error now due to the Sheet name.
What i need to reference is NOT BY Sheet NAME but by Active Sheet then Range
in that Sheet, SEE Comments Below with Arrows.
Sub Macro3()
' You must add a reference to the Microsoft outlook Library
' Don't forget to copy the function RangetoHTML in the module.
' Is not working in Office 97
Dim source As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set source = Nothing
On Error Resume Next
Set source = ThisWorkbook.Sheets("Sheet1").Range("B45:J107")
<=============== Want to Replace ("Sheet1") with ActiveSheet +
Range("B45:J107")
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 _
source.Cells.Count = 1 Or _
source.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
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
To = ThisWorkbook.Sheets("Sheet1").Range("B53").Value <=====
ActiveSheet + Range instead of ("Sheet1")
.CC = ThisWorkbook.Sheets("Sheet1").Range("E53").Value <====
ActiveSheet + Range instead of ("Sheet1")
.BCC = ""
.Subject = ThisWorkbook.Sheets("Sheet1").Range("B55").Value
<====ActiveSheet + Range instead of ("Sheet1")
.HTMLBody = RangetoHTML(source)
.Display 'or use .Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Public Function RangetoHTML(source As Range)
' 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:=source.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
Corey....
|