Tengo un libro que envía alertas, pero por cada línea que valida envía un correo, ¿Se puede unificar en 1 solo correo todas?

Tengo un archivo que tiene más de 3.000 filas con datos de personas, las cuales cada vez que le falten 5 días para vencer el curso envía un correo con esa alerta, pero por ser tantas filas que valida envía muchos correos, y satura la bandeja de entrada, ¿no es posible unificar todas esas alertas que encuentre en 1 único correo?

1 respuesta

Respuesta
2

Asumo que usas, como objeto, Outlook y que en cada una de esas 3000 filas debe haber al menos una columna con los correos ¿es así? Es decir el día de tu "alerta" envías ¿3000 mensajes? Me llama la atención por los límites que tiene Microsoft Outlook, y en general casi todo servidor de correos pero bueno, la idea entonces es ¿qué todo salga en un solo mensaje con los 3000 destinatarios? Comentas

Abraham Valencia

No, los destinatarios solo son 4, osea por ejemplo en la fila 1 esta pepito perez que le faltan 5 días para finalizar labores, entonces la macro valida esa fila y si cumple esa condición envía un correo diciendo que a pepito perez le faltan 5 días a los 4 destinatarios que especifique, y continua con la siguiente fila con un while hasta la ultima con datos, entonces por cada fila que cumple condición envía un correo individual a los mismos 4 destinatarios, es posible resumir todos los que cumplan dentro del texto de un solo correo ? para no llenar tanto la bandeja de entrada de los 4 destinatarios? es que son mas de 3.000 filas que valida, gracias

Claro que se puede, simplemente no debes hacer que, cada vez que tu bucle detecta una "alerta", envíe un mensaje sino que "acumule" destinatarios. No puedo darte detalles ya que no conozco tu macro

Abraham Valencia

Esta es la fórmula de la macro, agradezco me ayudes donde puedo poner ese acumulado, gracias

Sub alarma()

Application.Workbooks("aviso.xlsm").Activate
Sheets("aviso").Select
Dim xFil As Long
For xFil = 1 To Range("AY" & Rows.Count).End(xlUp).Row
val1 = Range("AX" & xFil).Value
val2 = Date
val3 = Range("AW" & xFil).Value
val6 = Range("AU" & xFil).Value - Date
val7 = Range("AR" & xFil).Value

If val7 = "primer aviso" Then
Shell ("Outlook")
Set objOutlook = CreateObject("Outlook.Application")
Set MYITEM = objOutlook.CreateItem(olMailItem)
Application.DisplayAlerts = False
With MYITEM
Set objOutlookRecip = MYITEM.Recipients.Add("correo")
.CC = "correo"
.Subject = "aviso"
.Body = "Cordial saludo, se informa aviso."
.Importance = olImportancehigh
.Send
End With
Set objOutlook = Nothing
ActiveWorkbook.Save
End If
Next xFil
Application.ScreenUpdating = True
End Sub

Con los if manejo que envíe alerta cuando faltan 8 días y luego envíe otra cuando falten 3 y así.

Según lo que acabas de enviar, tu bucle recorre varias filas y casa vez que encuentra una que dice "primer aviso" envía un mensaje de correo a un recipiente llamado "correo" que asumo son los 4 o 5 destinatarios de "siempre", dicho mensaje no adjunta nada y siempre es el mismo: Mismo "Asunto", mismo "Cuerpo". Entonces ¿cuál es la necesidad de enviarlo tantas veces?

Abraham Valencia

Son personas diferentes osea es una base de datos en la que tengo registrada a 2.000 personas, cada dato de una persona esta en una fila, osea en la fila uno esta abraham valencia que tiene fecha de caducidad de curso el 20 de diciembre osea en 5 días, entonces envía correo a los 4 destinatarios para que se enteren que faltan 5 días y así puedan gestionar que se renueve el curso, en la siguiente fila esta otra persona, ejemplo carlos jose, y la fecha de caducidad igual es el 20 de diciembre osea en 5 días, así que la macro envía otro correo enviando un mensaje que a esa persona igual hay que renovarle, y así sucesivamente en toda la base de datos, la finalidad es que avise cuando alguien se le vaya vencer el curso para renovarlo, ¿me explique bn?

Aclaro el cuerpo del mensaje no siempre es el mismo, ya que usa esta fórmula:

.Body = "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias."

Osea en el correo vota los datos básicos de la persona sin necesidad de abrir el excel y buscarlo

Mi consulta es si puedo acumular todos esos:

.Body = "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias."

En 1 solo correo con todas las personas que cumplan la validación y lo envíen a los 4 remitentes, ya que la que tengo ahora envía un correo por cada

.Body = "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias."

Y si son 3.000 filas son muchos correos que envía seguidos a los 4 remitentes, gracias

Lo primero que haría yo es separar las cosas: Primero la búsqueda de tus "alertas" y después el envío´; tu tienes tu bucle de búsqueda anidado con los envíos.

En ese bucle de búsqueda yo iría agregando lo destinatarios algo así:

If cell(x,y) = "Lo que corresponda" Then

DireccionesdeDestino = DireccionesdeDestino & Cells (x, z) & "; "

End If

(En donde (x, y) es la celda del dato y (x, z) la del correo)

Así la variable "DireccionesdeDestino" va acumulando todas las direcciones de correo a las que enviar el mensaje. Una vez terminado el bucle, ya en la parte del envío iría algo así:

Email.To = DireccionesdeDestino

Abraham Valencia

No entiendo, los correos no están en ninguna celda, osea son los mismos 4 de siempre, por ende los especifico en la macro directamente, para que quería acumular direcciones de correo si siempre va a los mismos 4 sea cual sea la alerta, osea lo que quisiera es que en un correo se acumulen las alertas tipo así:

.Body = "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias."

.Body = "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias."

.Body = "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias."

.Body = "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias."

En las que obviamente cada una arroja el dato de la persona correspondiente, como vez en la macro actual esos 4 .body que pegue serian 4 correos individuales a las mismas personas, la idea es que sea 1 solo con esa información, para así enviarlo a los 4 destinatarios, gracias

Jajjaaja, ya me había mareado, pero bueno, en todo caso, igual un bucle con IF y vamos agregando/sumando al "body", aunque lo que en realidad hay que usar es "HTMLBody":

SuperBody =  "<HTML><BODY><font face = arial size = -1>La información al día de hoy es<BR><BR> "

If ....................

SuperBody = SuperBody & "se informa que el Sr " & Range("AS" & xFil).Value & " el cual desempeña el cargo de  " & Range("AT" & xFil).Value & " y posee el curso de  " & Range("AW" & xFil).Value & ", le faltan Ocho (8) días para la finalización , por lo cual es necesario renovar, gracias." & "<BR><BR>"

End If

y al final del bucle y antes del correo, uno más:

SuperBody = Superbody & "</BODY></HTML>"

y en el correo ya no "Body", sino:

.HTMLBody = SuperBody

Abraham Valencia

No sé porque no sale mi respuesta...

Abraham Valencia

Eres grande, era justamente lo que necesitaba, funciono perfecto, muchas gracias, otra consulta cuando intento encadenar una fecha en ese texto me lo arroja como -454666 y no como formato de fecha 12 de junio 2017 o 12-07-17, sabes si es posible hacer eso dentro del . superbody?

lo otro es que tengo esta macro que envía la hoja activa adjunta, puedo acumular todos los adjuntos igual como con el .superbody? este es el código:

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcwb As Workbook
Dim estwb As Workbook
Dim TempFilePath As String
Dim TempFileNa As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
With Destwb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Error"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Base Sebastopol - Morelco " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "correo
.Subject = "aviso
.Body = "Cordial saludo, se informa que el Sr " & Range("AS" & xFil).Value & " el cual tiene el cargo de " & Range("AT" & xFil).Value & "  restan 4 días para terminación de curso, se adjunta archivo individual."
.Attachments.Add Destwb.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

No sé si soy grande, mi talla es 1.74 jajajaj. Gracias y que bueno que te resulto.

Sobre las otras preguntas, por favor cierra esta y abre una nueva por favor.

Gracias estimado y por ahí "nos vemos"

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas