Macro para enviar correo a destiantarios fijos

Me pueden apoyar, tengo una macro que al ejecutar, me arroja un cuadro donde pueda colocar un nombre para que sea enviado el archivo por correo electrónico y me habré la ventana del Outlook, el tema es que unicamente adjunta el archivo con el nombre que le puse, lo que necesito es que también me aparezca los destinatarios y el cuerpo del correo, es decir que siempre los mande a las mismas cuentas de correo para que no se ingresen manual.

La macro que tengo es la siguiente:

Sub EviarHojaEmail()
'
Dim NombreArchivo As String
Dim RutaTemporal As String
Dim Mensaje As String
    '
    On Error Resume Next
    '
    Mensaje = "Estás a punto de enviar la hoja activa por email. Ingresa el nombre con que se enviará el archivo o deja en blanco para que el archivo tenga el nombre de la hoja."
    NombreArchivo = InputBox(Mensaje, "EXCELeINFO")
    '
    If NombreArchivo = "" Then NombreArchivo = ActiveSheet.Name
    '
    RutaTemporal = Environ("temp") & "\"
    NombreArchivo = RutaTemporal & NombreArchivo & ".xlsx"

    ActiveWorkbook.ActiveSheet.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs NombreArchivo
    Application.DisplayAlerts = True
    CommandBars.ExecuteMso ("FileSendAsAttachment")
    ActiveWorkbook.Close False
    Kill NombreArchivo
    '
    On Error GoTo 0
    '
End Sub

Añade tu respuesta

Haz clic para o