¿Cómo enviar un email automático desde EXCEL usando vba al cumplirse cierta condición?
Soy relativamente nuevo y tengo una duda muy puntual
He revisado los casos de emails automáticos anteriores, pero al parecer todos son directos, es decir, ninguno cumple alguna condición para que se envíen.
El asunto es el siguiente, yo tengo un libro con una hoja llamada "TAREAS PENDIENTES" para recordar que existen tareas pendientes de la cual quiero enviar un correo por outlook al abrirse, al cumplirse que si una celda en la Columna QUE tiene una "P" (es decir, la tarea está pendiente) y que si faltan 3 o menos días para que se venza la tarea (la fecha de entrega va en la Columna I) se envíe un mail al correo del responsable que va en la Columna ES y la Tarea que va en la Columna J.
Es decir, algo así
Subject TAREA PENDIENTE
To RESPONSABLE
Body señor "nombre del responsable", su tarea debe entregarse el día "fecha de entrega", recuerde que la tarea es "tarea". GRACIAS
En serio necesito su ayuda, es para mejorar el ambiente de trabajo con mis compañeros, estuve buscando y viendo videos en youtube, pero no encuentro la forma de hacerlo.
Si es por outlook.
Pon la siguiente macro en los eventos de tu libro
Private Sub Workbook_Open()
'Por.Dante Amor
Set h = Sheets("TAREAS PENDIENTES")
For i = 3 To h.Range("C" & Rows.Count).End(xlUp).Row
If h.Cells(i, "I") <> "" And IsDate(h.Cells(i, "I")) Then
If h.Cells(i, "K") = "P" And h.Cells(i, "I") <= Date + 3 Then
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = h.Cells(i, "S").Value
dam.Subject = "TAREA PENDIENTE"
dam.Body = "Señor " & h.Cells(i, "C").Value & _
", su tarea debe entregarse el día " & h.Cells(i, "I").Value & _
", recuerde que la tarea es " & h.Cells(i, "J").Value & ". GRACIAS"
dam.Send 'El correo se envía en automático
'dam.Display 'El correo se muestra
End If
End If
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End SubInstrucciones para poner la macro en los eventos ThisWorkbook
- Abre tu libro de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
- En el panel del lado derecho copia la macro
- Guarda el archivo como excel habilitado para macros.
- Cierra el archivo.
- Abre el archivo habilitando las macros, en automático se ejecutará la macro y enviará los correos que cumplan con las condiciones.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Buenos días DANTE, el problema es que se me pasó que los correos los tenia en una hoja en el mismo libro que se llama "Hoja2" en la misma columna "S". ¿Habrá forma de ponerle que si el nombre del responsable en la hoja "TAREAS PENDIENTES" es igual al nombre del responsable al lado del correo en la hoja "Hoja2" lo use para enviar? Pues para no hacerlo manual si una misma persona tiene muchas tareas.
Sin embargo me parece que funciona de 10. Muchísimas gracias de antemano, creo que todos te estaremos agradecidos
Entonces pon una imagen de la hoja "TAREAS PENDIENTES" y otra imagen de la hoja2 para ver cómo tienes los datos. Procura poner ejemplos más reales para ajustar la macro.
Saludos,
DANTE te ofrezco disculpas, pero el sistema arroja las tareas pendientes con una información adicional como números telefonicos, identificaciones y demás. Aquí en Colombia es demandable usar hasta el nombre de una persona por lo que me veo forzado a utilizar esa clase de ejemplos. Me disculpo si se me pasó que los correos los tenia en otra hoja.
Todo es igual en la hoja "TAREAS PENDIENTES", solo que la idea es usar los correos que salen en la hoja "Hoja2" para no tener que pegarselos a cada tarea, pues es lo unico que el sistema no arroja
En la "Hoja2" los datos van desde la fila 2 hasta el "infinito", teniendo el nombre del responsable en la columna "H" y el correo en la columna "S". De esta forma:
Te anexo la macro actualizada
Sub EnviarCorreo()
'Por.Dante Amor
Set h = Sheets("TAREAS PENDIENTES")
Set h2 = Sheets("Hoja2")
For i = 3 To h.Range("C" & Rows.Count).End(xlUp).Row
If h.Cells(i, "I") <> "" And IsDate(h.Cells(i, "I")) Then
If h.Cells(i, "K") = "P" And h.Cells(i, "I") <= Date + 3 Then
Set b = h2.Columns("H").Find(h.Cells(i, "C"), lookat:=xlWhole)
If Not b Is Nothing Then
correo = h2.Cells(b.Row, "S").Value
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = correo
dam.Subject = "TAREA PENDIENTE"
dam.Body = "Señor " & h.Cells(i, "C").Value & _
", su tarea debe entregarse el día " & h.Cells(i, "I").Value & _
", recuerde que la tarea es " & h.Cells(i, "J").Value & ". GRACIAS"
'dam.Send 'El correo se envía en automático
dam.Display 'El correo se muestra
End If
End If
End If
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
