Macro para disparar correos automáticos desde una BD

Te anexo las macros para la opción 2.

La siguiente macro la tienes que poner en los eventos de workbook, de esta forma cada vez que abras el libro se revisarán todas las fechas y si están en 10 o menor a 10 enviará el correo.

Private Sub Workbook_Open()
'Por.Dante Amor
    Dim f As Date
    Set h1 = Sheets("Resumen")
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If IsDate(h1.Cells(i, "B")) Then
            f = h1.Cells(i, "B")
            h1.Cells(i, "E") = DateSerial(Year(f), Month(f) + 2, Day(f))
            h1.Cells(i, "F") = h1.Cells(i, "E") - Date
            If h1.Cells(i, "F") < 11 Then
                CorreoDam i
            End If
        End If
    Next
End Sub

La siguiente macro la tienes que poner en un módulo.

Sub CorreoDam(i)
'Por.Dante Amor
    Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = Sheets("Resumen").Range("H" & i)
        dam.Cc = Sheets("Resumen").Range("I" & i)
        dam.Subject = "Alerta de vencimiento de revisión preventiva " & Range("A" & i)
        'dam.display
        dam.send
    Set dam = Nothing
End Sub

También te anexo tu archivo con las macros.

Te sugiero que antes de habilitar las macro, pongas los correos, ya que si activas las macros se empezarán a enviar los correos con menos de 10 días y si no hay correo, te enviará un error en outlook.

https://www.dropbox.com/s/982e9whstx54pqn/Control%20Bimestral%20v.2.0%20dam.xlsm?dl=0 

Dante mil gracias por la respuesta, descargue el archivo enviado, coloque los correos (imagen 1), al abrir de nuevo el archivo sale un error de tiempo de ejecución (imagen 2), y la depurar el error lo marca en el modulo (imagen 3).

Que se puede hacer?

Dam me puse a unir un poco la que tenia con la que enviaste y me salió esto:

Sub CorreoDam(i)
'Por.Dante Amor
    Set dam = CreateObject("outlook.application")
    Set dam2 = dam.createitem(olmailitem)
        dam2.To = Sheets("Resumen").Range("H" & i)
        dam2.Cc = Sheets("Resumen").Range("I" & i)
        dam2.Subject = "Alerta de vencimiento de revisión preventiva " & Range("A" & i)
        dam.display
        dam.send
    Set dam = Nothing
End Sub

Pero vuelvo al mismo error del punto 1 de la pregunta original, sale en "To":

No modifiques la macro, la macro funciona correctamente, la probé varias veces.

Pero yo tengo excel 2007 y outlook 2007 (office 2007).

Qué versiones tienes, empezando por si tienes instalado outlook en tú máquina.

Hola, debe ser eso.. por aquello de la arquitectura... el mío es 2013... con Office 365..

Los cambios los hice después de probar la que me enviaste...

Revisar la información en el siguiente enlace para enviar correos desde office 365

http://www.emailarchitect.net/easendmail/kb/vb.aspx?cat=4 

Dante no fui claro, uso Outlook, todo el paquete de oficie local, solo que es con la suscripción anual de Office 365. pero la idea es ejecutar desde Excel y que dispare el correo de Outlook.

Sí entendí, por eso quiero que veas otras opciones de envío de correo, ya que por algún motivo el outlook que tienes no acepta la instrucción .to

Gracias... mira este enlace.. copie el código tal cual en un libro nuevo pero me toma errores..

http://msdn.microsoft.com/es-es/library/ms269113.aspx 

Leyendo lo que me envías eso aplica Outlook 365 en la nube, y no trabajo por la nube. trabajo un Outlook normal (versión escritorio), versión 2013 como el resto del paquete que tengo instalado de Office.

El único cambio que debemos buscar es el erro en la instrucción To...

Que me propones?

Esta puede ser una opción: Cambia tu versión de outlook a versión 2007

Otra opción es que envíes el correo utilizando gmail o hotmail. El código es el siguiente:

Para hotmail

Sub SendMail_hotmail()
'Fuente: http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/337-enviar-correo-en-vb-con-microsoft-cdo.htm
Dim Email As CDO.Message
Set Email = New CDO.Message
correo = "[email protected]"
passwd = "clave"
destino = "[email protected]"
mensaje = "mensaje1"
cuerpo = "cuerpo"
Email.Configuration.Fields(cdoSMTPServer) = "smtp.live.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(25)
    .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
    .To = destino
    .From = correo
    .Subject = mensaje
    .TextBody = cuerpo
    .Configuration.Fields.Update
    On Error Resume Next
    .Send
End With
If Err.Number = 0 Then
    MsgBox "El mail se envió con éxito", vbInformation, "Informe"
Else
    MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
End Sub

Para gmail

Sub SendMail_Gmail()
'Mod.Por.DAM
Dim Email As CDO.Message
correo = "[email protected]"
passwd = "pwd"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    Set Email = New CDO.Message
    Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
    Email.Configuration.Fields(cdoSendUsingMethod) = 2
    With Email.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
        .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    End With
    With Email
        .To = Cells(i, "A")
        .From = correo
        .Subject = Cells(i, "B")
        .TextBody = Cells(i, "C")
        .AddAttachment Cells(i, "E") & Cells(i, "D")
        .Configuration.Fields.Update
        On Error Resume Next
        .Send
    End With
    If Err.Number = 0 Then
        Cells(i, "F") = "El mail se envió con éxito"
    Else
        Cells(i, "F") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
    End If
    Set Email = Nothing
Next
End Sub

Revisar el código de cada opción y adáptalo a tu archivo

¡Gracias! Dante mil gracias por tu apoyo y tiempo, voy a publicar la pregunta sobre el error en 2013 a ver si alguien me puede ayudar en este atasco...

Dante... buenas noches, el problema no es la arquitectura.. es mi office, ya lo cambie y funciona perfectamente.... ayúdame con ultimo detalle en este tema..

Esta es la rutina que me en enviaste:

Private Sub Workbook_Open()
'Por.Dante Amor
    Dim f As Date
    Set h1 = Sheets("Resumen")
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If IsDate(h1.Cells(i, "B")) Then
            f = h1.Cells(i, "B")
            h1.Cells(i, "E") = DateSerial(Year(f), Month(f) + 2, Day(f))
            h1.Cells(i, "F") = h1.Cells(i, "E") - Date
            If h1.Cells(i, "F") < 11 Then
                CorreoDam i
            End If
        End If
    Next
End Sub

Ayúdame para se ejecute la rutina solo para las revisiones que tienes entre 9 y 11 días  y no las menores de 11.

Espero tu respuesta.

Ya decía que tenías que cambiar tu outlook.

En la macro cambia

< 11

Por

= 10

Prueba y me comentas

Dejando solo 10 me limita que si un día no se abre el archivo no se enviaran los correos necesarios... por eso quisiera que se disparara si encuentra valores entre 8 y 10..eso nos dará 3 días de soporte a los recordatorios... es posible me ayudes?