Macro para seleccionar varias celdas y enviar por correo electrónico .

Question

el 7 mar. 15

Macro para seleccionar varias celdas y enviar por correo electrónico .

Para: Dante Amor.

Buenas noches por favor su valiosa ayuda. Requiero una macro para seleccionar un rango de celdas y posterior a esto enviar a un correo electronico; esto lo necesito para enviar boletas de pago del personal y así no imprimir y gastar papel y contribuir con el planeta.

Encontré la macro que detallo en la parte de abajo, la cual funciona correctamente, pero quiero que la misma macro luego me seleccione otro rango y me envié a otro correo al mismo tiempo, he copiado las mismas instrucciones y solamente he cambiado lo siguiente: correo = Range("d24").Value ; Range("c22:f40"). Copy, pero no me ha funcionado.

Favor su ayuda.

Sub correo_Macro2()

Dia = Range("i2").Value
Mes = Range("j2").Value
correo = Range("d3").Value
Range("c7:f21").Copy
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.createitem(olmailitem)
parte2.to = correo
parte2.Subject = "ROL DE PAGOS " & Mes & " " & Dia
parte2.display
Application.SendKeys "^v", True
DoEvents
Application.Wait Now + TimeValue("00:00:01")
DoEvents
parte2.send
Set parte1 = Nothing
Set parte2 = Nothing
End Sub

2 Respuestas

Respuesta de jarasalo

-1

Y como eliges el rango

el 9 mar. 15

Dante Amor, https://www.youtube.com/@CursosDeExcelyMacros · Accepted Answer · 2015-03-07T01:37:19.0000000Z

Respuesta de Dante Amor

1

Prueba así:

Sub correo_Macro2()
    Dia = Range("i2").Value
    Mes = Range("j2").Value
    correo = Range("d3").Value
    Range("c7:f21").Copy
    Set parte1 = CreateObject("outlook.application")
    Set parte2 = parte1.createitem(olmailitem)
    parte2.to = correo
    parte2.Subject = "ROL DE PAGOS " & Mes & " " & Dia
    parte2.display
    Application.SendKeys "^v", True
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")
    DoEvents
    parte2.send
    Set parte1 = Nothing
    Set parte2 = Nothing
    '
    correo = Range("d24").Value
    Range("c22:f40").Copy
    Set parte1 = CreateObject("outlook.application")
    Set parte2 = parte1.createitem(olmailitem)
    parte2.to = correo
    parte2.Subject = "ROL DE PAGOS " & Mes & " " & Dia
    parte2.display
    Application.SendKeys "^v", True
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")
    DoEvents
    parte2.send
    Set parte1 = Nothing
    Set parte2 = Nothing
End Sub

Saludos.Dante Amor

el 7 mar. 15

Estimado Dante la macro funciona, pero en la segunda instrucción se envía el correo pero no con el rango copiado, es decir llega vacío el correo.

Favor su ayuda

el 9 mar. 15

Te anexo la macro actualizada

Sub correo_Macro2()
    Dia = Range("i2").Value
    Mes = Range("j2").Value
    If Range("d3") <> "" And Range("d24") <> "" Then
        correo = Range("d3").Value
        Range("c7:f21").Copy
        Set parte1 = CreateObject("outlook.application")
        Set parte2 = parte1.createitem(olmailitem)
        parte2.to = correo
        parte2.Subject = "ROL DE PAGOS " & Mes & " " & Dia
        parte2.Body = ""
        Parte2. Display
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Application.SendKeys "^v", True
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Parte2. Send
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Set parte1 = Nothing
        Set parte2 = Nothing
        '
        DoEvents
        correo = Range("d24").Value
        Set parte1 = CreateObject("outlook.application")
        Set parte2 = parte1.createitem(olmailitem)
        parte2.to = correo
        parte2.Subject = "ROL DE PAGOS parte2" & Mes & " " & Dia
        parte2.Body = ""
        Parte2. Display
        Range("c22:f40"). Copy
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Application.SendKeys "^v", True
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Parte2. Send
        Application. Wait Now + TimeValue("00:00:03")
        DoEvents
        Set parte1 = Nothing
        Set parte2 = Nothing
    Else
        MsgBox "Falta correo en la celda D3 o D24"
    End If
End Sub

el 9 mar. 15

Estimado Experto he actualizado la macro en base a lo aconsejado y he tenido los siguientes inconvenientes:

1.- La parte 2 ("c22:F40") llega por email al correo 1 ("d3"); debería llegar al correo 2 ("d24")

2.- La parte 1 ("c7:f21") llega por email al correo 2 ("d24") debería llegar al correo 1; y adicional este llega vacío.

Favor su ayuda

el 9 mar. 15

A mí me funciona muy bien!

Estoy incrementando el tiempo de espera, para que el correo se cargue, se pueda pegar la información y después se envíe. Puede ser que tu correo tiene problemas al abrirse, entonces cuando llega la imagen del primer correo todavía no se abre el correo, entonces llega la imagen del segundo correo y es cuando el primer correo apenas abrió y por eso recibe la imagen del segundo correo.

Prueba con esta macro y me comentas.

Sub correo_Macro2()
    Dia = Range("i2").Value
    Mes = Range("j2").Value
    If Range("d3") <> "" And Range("d24") <> "" Then
        correo = Range("d3").Value
        Range("c7:f21").Copy
        Set parte1 = CreateObject("outlook.application")
        Set parte2 = parte1.createitem(olmailitem)
        parte2.to = correo
        parte2.Subject = "ROL DE PAGOS " & Mes & " " & Dia
        parte2.Body = ""
        Parte2. Display
        DoEvents
        Application. Wait Now + TimeValue("00:00:05")
        DoEvents
        Application.SendKeys "^v", True
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Parte2. Send
        Application. Wait Now + TimeValue("00:00:03")
        DoEvents
        Set parte1 = Nothing
        Set parte2 = Nothing
        '
        DoEvents
        correo2 = Range("d24").Value
        Set parte1 = CreateObject("outlook.application")
        Set parte2 = parte1.createitem(olmailitem)
        parte2.to = correo2
        parte2.Subject = "ROL DE PAGOS parte2" & Mes & " " & Dia
        parte2.Body = ""
        Parte2. Display
        Range("c22:f40"). Copy
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Application.SendKeys "^v", True
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Parte2. Send
        Application. Wait Now + TimeValue("00:00:03")
        DoEvents
        Set parte1 = Nothing
        Set parte2 = Nothing
    Else
        MsgBox "Falta correo en la celda D3 o D24"
    End If
End Sub

el 9 mar. 15

Estimado, ya chequee haber si el problema es de outlook pero todo esta bien

Me sigue generando problema el primero se va .. pero el segundo se envía sin información

el 9 mar. 15

Sigue aumentando el tiempo para ver con cuál te funciona bien.

Cambia el número en estas líneas, significa que debe esperar 5 segundos, aumenta todas las líneas a 7 y prueba

Application. Wait Now + TimeValue("00:00:05")

el 9 mar. 15

Como ya te comenté a mí me funciona muy bien en excel 2007, incluso con menos tiempo.

La otra que se me ocurre es que pongas 2 botones, en un botón pones el código para enviar el correo1 y en el otro botón pones el código para enviar el correo2:

Correo1:

Sub correo1()
    Dia = Range("i2").Value
    Mes = Range("j2").Value
    If Range("d3") <> "" Then
        correo = Range("d3").Value
        Range("c7:f21").Copy
        Set parte1 = CreateObject("outlook.application")
        Set parte2 = parte1.createitem(olmailitem)
        parte2.to = correo
        parte2.Subject = "ROL DE PAGOS " & Mes & " " & Dia
        parte2.Body = ""
        Parte2. Display
        DoEvents
        Application. Wait Now + TimeValue("00:00:05")
        DoEvents
        Application.SendKeys "^v", True
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Parte2. Send
        Application. Wait Now + TimeValue("00:00:03")
        DoEvents
        Set parte1 = Nothing
        Set parte2 = Nothing
    Else
        MsgBox "Falta correo en la celda D3"
    End If
End Sub

Correo2

Sub correo2()
    Dia = Range("i2").Value
    Mes = Range("j2").Value
    If Range("d3") <> "" And Range("d24") <> "" Then
        DoEvents
        correo2 = Range("d24").Value
        Set parte1 = CreateObject("outlook.application")
        Set parte2 = parte1.createitem(olmailitem)
        parte2.to = correo2
        parte2.Subject = "ROL DE PAGOS parte2" & Mes & " " & Dia
        parte2.Body = ""
        Parte2. Display
        Range("c22:f40"). Copy
        DoEvents
        Application. Wait Now + TimeValue("00:00:05")
        DoEvents
        Application.SendKeys "^v", True
        DoEvents
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
        Parte2. Send
        Application. Wait Now + TimeValue("00:00:03")
        DoEvents
        Set parte1 = Nothing
        Set parte2 = Nothing
    Else
        MsgBox "Falta correo en la celda D24"
    End If
End Sub

el 9 mar. 15

¡Gracias! Estimado no me ha funcionado ..quizá sea la version de excel

Lo que se me ha ocurrido es utilizar una sola plantilla para todo el personal, así a través de validación de datos voy buscando el empleado y se van actualizando los valores.

Posterior a esto he creado un botón para que ejecutar una sola macro empleado por empleado; al inicio la macro se ejecuta correctamente pero al momento de ingresar otro nombre de empleado y ejecutar la macro esta me copia los datos del anterior empleado.

me puede ayudar . gracias

Adjunto la macro definitiva y el ejemplo

el 10 mar. 15

5 comentarios

Y se podría hacer un formulario para que envíe el rango ( c1.. j245) que yo le diga en ese formulario, poer como formulario que salga y se ligas la celda a coger, por ejemplo en el caso del día, mes, correo que le digamos nosotros la celda y que no tenga el rango - jarasalo

el 9 mar. 15

Hola: Podrías crear una pregunta nueva en el tema de microsoft excel, en el título escribe que es para enviar un correo. me pones todos los datos que necesitas con un ejemplo y con gusto te preparo la macro. En el detalle de la pregunta escribe que es para Dante Amor. saludos - Dante Amor

el 9 mar. 15

Hola podrías enviar este ejemplo con la plantilla y la macro, para poder verla y ver si me puede hacer a mi el apaño para la mía eleigiendo en vex del empelado, un suministrador, es que no se como traes en la plantilla los datos que quieres gracias - jarasalo

el 10 mar. 15

hola la plantilla la he hecho con validación de datos, es decir solamente tengo que seleccionar el nombre del empleado y todo lo demás está formulado, la plantilla es la que adjunte así como la macro.El problema que tengo es que al inicio la macro se ejecuta correctamente y manda un mail con toda la información pero al momento de seleccionar otro nombre y ejecutar la macro por segunda vez esta envía la información del primer nombre, tengo que ejecutar dos veces para que envíe correcta la informacion al mail correcto.Dante tal vez me puedes ayudar o tengo que hacer una nueva pregunta.gracias - jose luis soria

el 10 mar. 15

El problema no está en la macro, el problema está en outlook o en la versión que tienes de office. Tal vez es muy lento al enviar el correo. Incrementa el tiempo de espera, tal vez a 15 segundos, para que pruebes. Como ya te comenté, a mí me funciona incluso con menos tiempo de espera. saludos - Dante Amor

el 10 mar. 15

Macro para seleccionar varias celdas y enviar por correo electrónico .

2 Respuestas

Añade tu respuesta

Más respuestas relacionadas

Macro para enviar correo a Gmail

Macro para enviar automáticamente correos y programada para que sean todos los días a la misma hora

Enviar rango de celdas como imagen por outlook con macros

Para Dam - Macro envío correo desde Excel

Macro para copiar rango y enviar correo electrónico

Enviar correo desde excel con otro remitente

Macro para enviar correos y alterar el formato del cuerpo del correo

Pegar rango en cuerpo de mail

Macro Excel deshabilita el teclado numérico

Incluir firma al enviar correos automáticos desde excel 2003

Completar un video con una poesía

¿Cómo bloquear la desinstalación de aplicaciones en Android?

¿Cuáles son los pros y contras de tener dos antivirus al mismo tiempo?

Compra de portátil ¿Qué marcas son las más recomendables?