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

Respuesta
-1

Y como eliges el rango

1 respuesta más de otro experto

Respuesta
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

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

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

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


                    

                    

                        
                            

                    

                

            

            

                
                

                    

                        
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

                    

                    

                        
                            

                    

                

            

            

                
                

                    

                        
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

                    

                    

                        
                            

                    

                

            

            

                
                

                    

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

                    

                    

                        
                            

                    

                

            

            

                
                

                    

                        
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

                    

                    

                        
                            

                    

                

            

            

                
                

                    

                        
¡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

                    

                    

                        
                            

                    

                

            

              
                

            

            

                    

        

        

            

            
        

    

            


            

    

            


            


                

        
    










            
        






















     
    
    
    



    

        

            
Añade tu respuesta

        

        

            

                
            

            

                


    



        

            

                        Haz clic para 
    
        
    
             o 
    
        
    

            

        

    


    











                
            

        

    


    


    
    






    

       
                

                        Más respuestas relacionadas

                


                

                    

                        

    

        

            
                Macro para enviar correo a Gmail
            
        

        

            
                Tengo dos macros para el envío de una tabla desde mi correo de outlook 2010 a un destinatario en Gmail. Primera Macro: Sub Correo_macro1() Dia = Range("i2").Value Mes = Range("j2").Value correo = Range("d3").Value ' Select the range of cells on the...
            
        

            

        
                1  respuesta

    


    

    

        

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

        

            
                Quisiera que me ayudaran con una macro que pueda enviar correos automáticamente, yo ya he iniciado una macro que envía correos pero el problema es que lo hace "manual" porque tengo que darle "enviar" cuando me abre el outlook, yo necesito que cuando...
            
        

            

        
                1  respuesta

    


    

    

        

            
                Enviar rango de celdas como imagen por outlook con macros
            
        

        

            
                Necesito enviar un rango de celdas con macros, encontré un código que copia y pega el rango pero necesito que se pegue como "mapa de bits" osea como imagen por favor, miren lo que tengo: Private Sub CommandButton1_Click() Range("J251:K352").Select...
            
        

            

        
                2  respuestas

    


    

    

        

            
                Para Dam - Macro envío correo desde Excel
            
        

        

            
                HOl Dam, espero te encuentras bien! Tengo el siguiente problema: Estoy utilizando una macro para enviar n correo automático que depende del cambio en unas celdas especificas (que tu mismo me ayudaste a construir) pero resulta que este nuevo correo...
            
        

            

        
                1  respuesta

    


    

    

        

            
                Macro para copiar rango y enviar correo electrónico
            
        

        

            
                Tengo una hoja de excel y quisiera saber si hay alguna manera de hacer con una macro que copie el rango (B2:E11) y lo ponga en un correo electrónico de outlook, yo lo que hago es copiar y pegar eso manualmente, pero quisiera saber si hay manera de...
            
        

            

        
                3  respuestas

    


    

                                    

                                        
                                        
                                        
                                        

                                    

    

        

            
                Enviar correo desde excel con otro remitente
            
        

        

            
                Quisiera que me brindes tu apoyo con este inconveniente. Quiero enviar mensajes desde excel con macros. Sin embargo en el trabajo manejo 2 correos uno personal y otro del área donde laboro. Por ejemplo Correo personal: [email protected] correo del...
            
        

            

        
                1  respuesta

    


    

    

        

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

        

            
                Ojala me puedan ayudar, tengo una rutina para envío de correos, y jala perfecto solo que ahora me han pedido darle formato al mail algunas palabras en negritas y no se como hacer esa modificación ya que el texto esta en la rutina jala las fechas de...
            
        

            

        
                1  respuesta

    


    

    

        

            
                Pegar rango en cuerpo de mail
            
        

        

            
                He visto es macro que hiciste y no me funciona. Cuando se manda el mail llega SIN el rango de celdas que habíamos copiado. ¿Cómo se puede arreglar? Gracias, Sub correo() '***Macro Para enviar correos 'Por.Dam Set dam1 =...
            
        

            

        
                1  respuesta

    


    

    

        

            
                Macro Excel deshabilita el teclado numérico
            
        

        

            
                Tengo un problema con una macro que al ejecutarla me deshabilita el teclado numércico. Obviamente que para volver a utilizarlo solo hay que presionar la tecla BLOQNUM, pero resulta tedioso. Mi pregunta es si se puede colocar algo en el código para...
            
        

            

        
                2  respuestas

    


    

    

        

            
                Incluir firma al enviar correos automáticos desde excel 2003
            
        

        

            
                Tengo esta macro Ub enviar() Sheets("Control de alquiler").Select ufila = Range("A" & Rows.Count).End(xlUp).Row For i = 4 To ufila If Cells(i, 14) <= Cells(i, 15) Then Set parte1 = CreateObject("outlook.application") Set parte2 =...
            
        

            

        
                1  respuesta