" TablaHTML = TablaHTML & "Tarea | " TablaHTML = TablaHTML & "
Fecha limite | " TablaHTML = TablaHTML & "
Dias | " TablaHTML = TablaHTML & "
Estatus | " TablaHTML = TablaHTML & "" For Each fila In tblAct.ListRows If fila.Range.Columns(2).Value = Responsable Then If fila.Range.Columns(5).Value = "Vencido" Or _ fila.Range.Columns(5).Value = "En límite" Then TablaHTML = TablaHTML & "
" TablaHTML = TablaHTML & "| " & fila.Range.Columns(1).Value & " | " TablaHTML = TablaHTML & "" & fila.Range.Columns(3).Value & " | " TablaHTML = TablaHTML & "" & fila.Range.Columns(4).Value & " | " TablaHTML = TablaHTML & "" & fila.Range.Columns(5).Value & " | " TablaHTML = TablaHTML & "
" End If End If Next fila TablaHTML = TablaHTML & "" 'Crear correo Outlook Set OutlookApp = CreateObject("Outlook.Application") Set Mail = OutlookApp.CreateItem(0) With Mail .To = Correo .Subject = Asunto .HTMLBody = Mensaje & "
" & TablaHTML .Send End With Next Item End Sub"
width="135" height="240">
Sub EnviarAvisosPrueba() Dim wsAct As Worksheet Dim wsCor As Worksheet Dim tblAct As ListObject Dim tblCor As ListObject Dim fila As ListRow Dim filaCorreo As ListRow Dim Lista As Collection Dim Item As Variant Dim Responsable As String Dim Correo As String Dim Asunto As String Dim Mensaje As String Dim TablaHTML As String Dim OutlookApp As Object Dim Mail As Object Set wsAct = ThisWorkbook.Worksheets("Hoja1") Set wsCor = ThisWorkbook.Worksheets("Hoja2") Set tblAct = wsAct.ListObjects("tblActividades") Set tblCor = wsCor.ListObjects("tblCorreos") Set Lista = New Collection 'Obtener responsables únicos On Error Resume Next For Each fila In tblAct.ListRows If fila.Range.Columns(5).Value = "Vencido" Or _ fila.Range.Columns(5).Value = "En límite" Then Lista.Add fila.Range.Columns(2).Value, fila.Range.Columns(2).Value End If Next fila On Error GoTo 0 'Crear correo por responsable For Each Item In Lista Responsable = Item Correo = "" Asunto = "" Mensaje = "" 'Buscar datos del correo For Each filaCorreo In tblCor.ListRows If filaCorreo.Range.Columns(1).Value = Responsable Then Correo = filaCorreo.Range.Columns(2).Value Asunto = filaCorreo.Range.Columns(3).Value Mensaje = filaCorreo.Range.Columns(4).Value Exit For End If Next filaCorreo 'Crear tabla HTML TablaHTML = "
" TablaHTML = TablaHTML & "" TablaHTML = TablaHTML & "| Tarea | " TablaHTML = TablaHTML & "Fecha limite | " TablaHTML = TablaHTML & "Dias | " TablaHTML = TablaHTML & "Estatus | " TablaHTML = TablaHTML & "
" For Each fila In tblAct.ListRows If fila.Range.Columns(2).Value = Responsable Then If fila.Range.Columns(5).Value = "Vencido" Or _ fila.Range.Columns(5).Value = "En límite" Then TablaHTML = TablaHTML & "" TablaHTML = TablaHTML & "| " & fila.Range.Columns(1).Value & " | " TablaHTML = TablaHTML & "" & fila.Range.Columns(3).Value & " | " TablaHTML = TablaHTML & "" & fila.Range.Columns(4).Value & " | " TablaHTML = TablaHTML & "" & fila.Range.Columns(5).Value & " | " TablaHTML = TablaHTML & "
" End If End If Next fila TablaHTML = TablaHTML & "
" 'Crear correo Outlook Set OutlookApp = CreateObject("Outlook.Application") Set Mail = OutlookApp.CreateItem(0) With Mail .To = Correo .Subject = Asunto .HTMLBody = Mensaje & "
" & TablaHTML .Send End With Next Item End Sub