Para Dam - Macro envío correo desde Excel

Utiliza lo siguiente.

Sub Correo_Sini_4()
Worksheets("Sini (2)").Select
ActiveSheet.Unprotect Password:="XXXX"
Range("Z159:AB175").Copy
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.createitem(olmailitem)
parte2.To = Worksheets("Operativos").Range("J36") & ";" & Worksheets("Operativos").Range("J36")
parte2.Cc = Worksheets("Operativos").Range("C16")
parte2.Subject = "Alerta cambio de estado de los siniestros"
Parte2. Display
DoEvents
Application. Wait Now + TimeValue("00:00:05")
Application. SendKeys "^v"
DoEvents
Parte2. Send
Set parte1 = Nothing
Set parte2 = Nothing
Worksheets("Sini (2)").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="XXX"
End Sub

Le agregué estas líneas antes de pegar, porque el mail a veces tarda en abrir, entonces la macro se espera 5 segundos y después pega y después envía

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

Prueba y me comentas

Saludos. DAm

Dam mil gracias,

Funciona bien tu planteamiento, hace la espera y luego envía pero sigo con el problema de que a veces pega pero otras no... ahora ya es al contrario, mas veces la que lo hace bien que las que no pega.

Tengo una idea, existe la forma de decirle que le haga click en el display (cuerpo del mensaje), hacer esto antes de pegar?

parte2.display

Dar Click!!!

DoEvents

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

Application.SendKeys "^v"

DoEvents

Es que el portapapeles queda cargado, o sea el correo se va sin que se haya pegado el rango, pero si abro otro correo nuevo o me ubico en otra parte de excel y le doy Control V; el rango inicial pega sin problema.

O alguna otra cosa para que la acción sea efectiva todas las veces...

Si eso es un problema de las versiones de excel, en mi versión funciona sin el wait, sin el doevents, pero me pasa que otras personas con versión 2007 ó 2010, tienen ese problema, incluso lo han intentado aumentado a 10 segundos y nada.

Prueba con las siguientes líneas, para ver cómo te funciona

SendKeys "{SPACE}" 'Espacio

SendKeys "{ENTER}" 'Enter

SendKeys "^{END}" 'Ctrl fin, se va al final del mail

Si quieres probar otras teclas, revisa la siguiente página

http://www.autoitscript.com/autoit3/docs/appendix/SendKeys.htm

Si sigues teniendo problemas tendrás que enviar el rango de celdas pero concatenadas, en una cadena de texto.

Saludos. Dam

Valioso aporte...

No estoy seguro de los comando para concatenar en vba...

Monte esto pero me saca error en la adición de los rangos.....

Sub Correo_Sini_1()

Application.ScreenUpdating = False

Worksheets("Sini (2)").Select

Range("Z6:AB22").Copy

Set parte1 = CreateObject("outlook.application")

Set parte2 = parte1.createitem(olmailitem)

parte2.To = Worksheets("Operativos").Range("J36") & ";" & Worksheets("Operativos").Range("J36")

parte2.Cc = Worksheets("Operativos").Range("C16")

parte2.Subject = "Alerta cambio de estado de los siniestros"

parte2.display

Worksheets("Sini (2)").Range ("Z6") & ";" & Worksheets("Sini (2)").Range("Z7")

Worksheets("Sini (2)").Range ("AA6") & ";" & Worksheets("Sini (2)").Range("AA7")

Worksheets("Sini (2)").Range ("AB6") & ";" & Worksheets("Sini (2)").Range("AB7")

DoEvents

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

Application.SendKeys "{ENTER}"

Application.SendKeys "^v"

DoEvents

parte2.send

Set parte1 = Nothing

Set parte2 = Nothing

Worksheets("Sini (2)").Select

Range("I6").Select

Application.ScreenUpdating = True

End Sub

Como ves necesito meter tres renglones que vienen del excel:

Renglón 1: Z6 & Z7

Renglón 2: AA6 & AA7

Renglón 3: AB6 & AB7

Que estoy haciendo mal?

Así quedaría la macro, te comenté la parte que vas a copiar, y te puse la parte para enviar una cadena de texto

Sub Correo_Sini_4()
Worksheets("Sini (2)").Select
ActiveSheet.Unprotect Password:="XXXX"
'Range("Z159:AB175").Copy
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.createitem(olmailitem)
parte2.To = Worksheets("Operativos").Range("J36") & ";" & Worksheets("Operativos").Range("J36")
parte2.Cc = Worksheets("Operativos").Range("C16")
parte2.Subject = "Alerta cambio de estado de los siniestros"
For Each celda In Range("Z159:AB175")
    If celda <> "" Then
        cadena = cadena & " " & celda
    End If
Next
parte2.body = cadena
'parte2.display
'DoEvents
'Application.Wait Now + TimeValue("00:00:05")
'Application.SendKeys "^v"
'DoEvents
parte2.send
Set parte1 = Nothing
Set parte2 = Nothing
Worksheets("Sini (2)").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="XXXX"
End Sub

Saludos.Dam

Dam mil gracias.
Por ahora lo voy a dejar enviado solamente la cadena para que haya uniformidad.
Si llegas a saber de la solución del pegar (en ese rango no solo van datos sino una gráfica que es la que quiero que llegue a los correos de los Gerentes) me colaboraras?

Espero tu respuesta para darte tus merecidas 5 estrellas.