1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
| ub test_date()
Dim T_date
T_date = Date
Dim Rep As Integer
Dim Delai As Integer
Dim DernLigne As Long
Dim Cnt As Long
Dim plage As Range
Dim Message As String
Dim Sujet As String
Dim dateProche As Date
DernLigne = Range("F1048576").End(xlUp).Row
Dim I As Integer, prec As String
Delai = 1095 'en nombre de jours; 3 ans = 1095j
Cnt = 0
Set plage = Worksheets("feuil1").Range("F1: F65000 ")
plage.Interior.ColorIndex = xlNone
For I = 1 To DernLigne
If Range("F1").Offset(I).Value <> "" Then
If T_date - Delai > Range("F1").Offset(I).Value Then
' Range("F1").Offset(I).Interior.ColorIndex = 45
Cnt = Cnt + 1
' I = I + 1
End If
End If
Next I
dateProche = Application.WorksheetFunction.Min(plage)
If Cnt = 0 Then
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'corps du message si besoin
With OutMail
.To = "simeoni@legras.fr" 'destinataire(s)
'.CC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com" ' copie
'.BCC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com" ' si BCC
.Subject = "Pas de date a échéance"
.Body = "Bonjour, il n'y a pas de délai dépassé aujourd'hui, la prochaine échéance sera " & dateProche & ", soit dans " & dateProche + Delai + 1 - T_date & " jours."
'Piece_jointe
'.Attachments.Add ("C:\test.txt") 'mettre chemin et fichier a joindre
'.Display 'ouvre Outlook
'or use
.Send 'envoi sans ouvrir Outlook
End With
Set OutMail = Nothing
Set OutApp = Nothing
Else
Set OutApp = CreateObject("Outlook.Application") 'Ca plante ici . Quand la macro est lancéé manuellement pas de soucis, mais quand elle est lancé à l'ouverture d'outlook ça plante. (mettre une tempo ne change rien)
Set OutMail = OutApp.CreateItem(0)
'corps du message si besoin
With OutMail
.To = "simeoni@legras.fr" 'destinataire(s)
'.CC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com" ' copie
'.BCC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com" ' si BCC
.Subject = "ATTENTION délai"
.Body = "Il y a " & Cnt & " dates arrivées à échéance aujourd'hui."
'Piece_jointe
'.Attachments.Add ("C:\test.txt") 'mettre chemin et fichier a joindre
'.Display 'ouvre Outlook
'or use
.Send 'envoi sans ouvrir Outlook
End With
Set OutMail = Nothing
Set OutApp = Nothing
'MsgBox "Il y a " & Cnt & " dates arrivées à echéance"
' For I = 1 To DernLigne
' If Range("F1").Offset(I).Value <> "" Then
' If T_date - Delai > Range("F1").Offset(I).Value Then
' Range("F1").Offset(I).Select
' I = I + 1
' End If
' End If
' Next I
End If
End Sub |
Partager