Enviar Rango de Celdas + Hoja por medio de Outlook

Revisa el siguiente enlace

https://www.rondebruin.nl/win/s1/outlook/bmail2.htm 

Realiza una prueba para enviar el rango de celdas

En esta parte:

    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)

Debería quedar así:

    'Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a fixed range if you want
    Set rng = Sheets("Hoja1").Range("A1:J20").SpecialCells(xlCellTypeVisible)

Y en esta parte adjunta tu archivo:

    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Attachments.Add ruta & nombre & ".xlsx"
        .HTMLBody = RangetoHTML(rng)
        .Send   'or use .Display
    End With

Previamente deberás guardar la hoja como un archivo.

Realiza pruebas.

Como siempre muchas gracias Dante Amor, justo ayer había visto el enlace que me dices pero no le entendí, ahora bien lo que me dices es que antes debo guardar la hoja que quiero adjuntar para posteriormente ejecutar la macro. Pero mi duda es ¿sera posible que se envié sin necesidad de guardarla previamente?, lo que pasa es que este archivo lo voy a pasar a otros usuarios y mi intención es simplificar procesos.

El problema puede ser las versiones, yo tengo excel 2007, puedo enviar la hoja y el rango de celdas y los veo sin problema. Incluso podrá funcionar en tu máquina, pero en otra máquina tal vez no.

Entiendo tu petición, pero como ya habrás visto, incluso en mis respuestas, a algunos sí les funciona y a otros no. Tal vez hoy te funcione, pero si mañana excel o outlook realizan una actualización, puede ser que ya no funcione.

Hay instrucciones estándar que no cambian mucho, como lo es adjuntar archivos. Intenta poner tus celdas importantes con las opciones que te he enviado y adjunta el detalle de tu información (hoja) como un archivo.

Seguiré probando por lo pronto me quedo claro una duda que tenia y bueno a seguir aprendiendo. Gracias y Saludos. 

Hola Dante Amor, solo para comentarte que hice un revoltijo de códigos y si me esta funcionando ja ja, se envía el rango de celdas en cuerpo de correo y además me adjunta la hoja pero quiero ver si le puedes echar un ojo a toda la macro para ver si es correcto o me puedes ayudar a mejorarla.

Sub Mail_Selection_Range_Outlook_Body()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim Path, TD, fn, mydoc As String
TD = Format(Date, "dd/mm/yyyy")
Path = ThisWorkbook.Path & "\"
fn = Sheets("Hoja2").name
mydoc = Path & fn & ".xlsx"
Sheets(fn).Copy
ActiveWorkbook.SaveAs Filename:=mydoc, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close False
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Hoja1").Range("A1:J20").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "La selección no es un rango o la hoja está protegida" & _
vbNewLine & "por favor corrija y vuelva a intentarlo.", vbOKOnly
Exit Sub
End If

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

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.subject = "Correo de Prueba"
.Body = "Este es un correo de Prueba, al día de hoy " & TD & ""
.attachments.Add mydoc
.HTMLBody = RangetoHTML(rng)
.Send
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
If Err.Number = 0 Then
SendMail_Gmail = True
MsgBox "El mail con archivo adjunto fue enviado con éxito", vbInformation, "AVISO"
Else
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
Kill mydoc
Set OutMail = Nothing
Set OutApp = Nothing
Set OM = Nothing
Set OA = Nothing
End Sub

Function RangetoHTML(rng As Range)

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"

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

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

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=")

TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function