Topic - Help Debugging Code : Placing a range in the body of an email.

[jamesg]

Hi All,

Topic - Help Debugging Code : Placing a range in the body of an email.

Am not programmer, I am cobbling together this and dont have the expertise to debug it! Can some one PLEASE help?


Sub CreateEmail()

'Clears a range that may cause a bug
Range("A501").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-500

'selects the range that I need placed in the body of an email WORKS GREAT
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("B4:R" & LastRow).Select

'NOT MY CODE...this opens an email but the range selected in
'the previous step does not get placed into the body of the email.

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

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

Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
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")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0

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

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

[shrivallabha]

Hi,
I have not used Outlook application and I do not have set it here so I can't check. The items marked with Dim are called variables and usually written at the top of the code. Here's updated code which should work:
Sub CreateEmail()
'*************************************************************************
'Declaring Variables
'*************************************************************************
Dim LastRow As Long
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
'*************************************************************************
'Clears a range that may cause a bug
'*************************************************************************
Range("A501:A" & Rows.Count).ClearContents
'*************************************************************************
'selects the range that I need placed in the body of an email WORKS GREAT
'*************************************************************************
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'*************************************************************************
'NOT MY CODE...this opens an email but the range selected in
'the previous step does not get placed into the body of the email.
'*************************************************************************
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
On Error Resume Next
Set rng = Range("B4:R" & LastRow) 'Setting the range reference of our choice
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")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "ron@debruin.nl" 'Place Email IDs where you want to send this mail
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0

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

Set OutMail = Nothing
Set OutApp = Nothing
End Sub