Saben como arreglar este problema no me selecciona mi rango es una tabla de un Excel
Sub Sendmail()
Application.ScreenUpdating = False
Dim OutlookOBJ As Object
Dim mItem As Object
Dim ruta_archivo As String
Range("B5").Select
Ultimo = Range(Selection, Selection.End(xlDown)).Count
cuerpo2 = Selection.Copy
For i = 2 To Ultimo
Range("B4")(i, 1).Select
Selection.Copy
Range("E2").Select
ActiveSheet.Paste
Range("A83:R352").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("E1:E2")
Range("A83").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Cuerpo Selection.Copy
Set parte1 = CreateObject("Outlook.Application")
Set parte2 = parte1.CreateItem(olMailItem)
parte2.to = Cells(3 + i, 3)
parte2.Subject = Cells(2, 7)
parte2.body = Cuerpo
DoEvents
parte2.Send
Next i
MsgBox " se mandaron los correos verificar informacion"
End Sub
1 Respuesta
H o la : Te anexo mis comentarios y una macro para pegar la información.
Esta instrucción no está almacenando la copia en una variable:
cuerpo2 = Selection.Copy
Lo que hace simplemente es copiar la celda seleccionada, en este caso la celda B5.
Lo mismo con esta instrucción.
Cuerpo Selection. Copy
No estás almacenando la selección en la variable Cuerpo, por lo tanto no puedes simplemente poner en el Body del correo esto:
Parte2. Body = Cuerpo
Lo que se hace en estos casos es copiar; y pegar lo copiado en el cuerpo del correo de esta forma:
SendKeys "^v", True
Lo que está indicando es que envíe el juego de teclas Control v, para que se realice el pegado.
Pegar de esa forma la información, tampoco resulta lo más conveniente, ya que depende de la versión de office, de windows, de la velocidad de tu máquina, de la memoria. En ocasiones no pega la información de manera rápida y envía el correo si la información. Lo que se hace en estos casos es poner una pausa en la macro para que le dé tiempo a outlook de abrir el correo y entonces pegar la información, para la pausa se puede utilizar esta instrucción:
Application. Wait Now + TimeValue("00:00:02")Te anexo la macro completa para copiar, abrir el correo, pegar, enviar y pasar al siguiente registro.
Sub EnviarCorreo()
'Por.Dante Amor
Application.ScreenUpdating = False
f = 5
u = Range("A" & Rows.Count).End(xlUp).Row
Do While Cells(f, "B") <> ""
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
Range("E2") = Cells(f, "B")
Range("A83:R" & u).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("E1:E2")
u2 = Range("A" & Rows.Count).End(xlUp).Row
If u2 > 83 And Cells(f, "C") <> "" And Cells(2, "G") <> "" Then
Range("A83:R" & u2).Copy
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.to = Cells(f, "C")
dam.Subject = Cells(2, "G")
dam.Display
Application.Wait Now + TimeValue("00:00:02")
SendKeys "^v", True
dam.Display
dam.Send
End If
f = f + 1
Loop
MsgBox " se mandaron los correos verificar informacion"
End SubSi no te funciona, incrementa el tiempo de espera a 5 segundos, por ejemplo:
Application. Wait Now + TimeValue("00:00:05")Si aún no te funciona, entonces se puede enviar la información de otra manera, puede ser por Html o copiar la información en un archivo nuevo y enviar el archivo en el correo.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias! eres muy bueno amigo lo que pasa es que es una base de datos donde primero aplicó un filtro avanzado para filtrar por.los nombres después de eso ya me arroja mis datos y esos son los que necesito por eso tenía el bucle para que me seleccione cada uno de los nombres los filtre y de hay me seleccione el resultado me pega en Outlook y ya jaja
Eso que describiste es lo que hace la nueva macro, si ya la probaste y te funciona, recuerda valorar la respuesta.
