Excel VBA envoi mail

bonjour,

j'ai un souci avec le code VBA ci dessous, le code envoie bien le mail mais il met dans le corps du mail toutes les dates de 2014 alors que je voudrais qu'il ne mette que le ou les documents pour lesquels la date de validité expire dans 30 jours !

j'ai joint le fichier pour faire des essais ma messagerie est outlook 2010

Sub MailOutlook()
        Dim OutApp As Object
        Dim OutMail As Object
        Dim strbody As String

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        strbody = "Bonjour" & vbNewLine & vbNewLine
        With Sheets("Feuil1")
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        If Date - .Range("D" & i) < 30 Then

        strbody = strbody & vbNewLine & _
                  "Le document " & .Range("A" & i) & " " & "arrive à sa fin de validité le " & .Range("D" & i) & " merci de demander son renouvellement."
        End If
        Next i
        End With
        On Error Resume Next
        With OutMail
            .To = "machin@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "Documents fin de validité"
            .Body = strbody
            .Display
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub

merci pour votre aide

Bonjour Astil,

Mieux vaut utiliser la fonction DateDiff()

Voici le code

Sub MailOutlook()
  Dim OutApp As Object
  Dim OutMail As Object
  Dim strbody As String

  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  strbody = "Bonjour" & vbNewLine & vbNewLine
  With Sheets("Feuil1")
    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
      If DateDiff("d", Date, .Range("D" & i).Value) < 30 Then

        strbody = strbody & vbNewLine & _
                  "Le document " & .Range("A" & i) & " " & "arrive à sa fin de validité le " & .Range("D" & i) & " merci de demander son renouvellement."
      End If
    Next i
  End With
  On Error Resume Next
  With OutMail
    .To = "machin@gmail.com"
    .CC = ""
    .BCC = ""
    .Subject = "Documents fin de validité"
    .Body = strbody
    .Display
  End With
  On Error GoTo 0

  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub

A+

Tu remplaces

If Date - .Range("D" & i) < 30 Then

par

If Date - .Range("D" & i) > 30 Then

dans ton test, c'est normal que cela ne fonctionne pas puisque il y a aucune dates inférieures à 30 jours ...

Cdlt