Macro para envió de mails en determinada fecha más días hábiles
Solicito su ayuda para complementar una macro para el envió de correos masivos en determinada fecha.
Mi problema es que no se donde ni como agregar una condición en la cual valide las fechas que tengo en la columna (C) y ha esas fechas tengo que sumarle 5 días hábiles para que se envíen los correos a cada asignado. Un ejemplo: en la columna C tengo la fecha: 04/07/2016 tiene que tomar esta fecha y sumarle 5 días hábiles para que el correo se envié la fecha: 11/07/2016 .
Aquí le dejo mi macro :
Sub enviarcorreo()
hoy = Date + 5 'Envio en 5 dias
ayer = Range("X3") '3 dias
manana = Range("X4") '5 dias
Range ("D2").Select
Dim OutApp As Object
Dim OutMail As Object
finalColumna = Range(Selection, Selection.End(xlDown)).Count
Do Until cont = finalColumna
cont = cont + 1
If (Cells (cont, 4) = "Z.F." And Cells (cont, 5) = "15") Then '*Condicion para comparar celdas
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
ActiveWorkbook.Save
correos = Cells (cont, 25).Value
tipo = Cells (cont, 4).Value
ocb = Cells (cont, 1).Value
nom = Cells (cont, 2).Value
On Error Resume Next
With OutMail
.To = ""
.CC = "" & correos
.BCC = ""
.Subject = "Primer Recordatorio"
.Body = " TIPO DE APROVECHAMIENTO: " & tipo & vbCrLf + " NUMERO: OCB-" & ocb & "/2016 " + vbCrLf + " NOMBRE O RAZON SOCIAL: " & nom & vbCrLf + vbCrLf + " Termino de pazo de Manifestacion del visitado, preparar Informe Ejecutivo para envio a calificacion de Infracciones " + vbCrLf + "Por su atencion Gracias!!"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Loop
MsgBox "Termino envio de Correo", , "Envio Exitoso!!!"
End Sub