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

Añade tu respuesta

Haz clic para o