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
| Sub Envoi_mail_dd()
' Envoi mail
Dim OutApp As Object
Dim OutMail As MailItem
Dim cell As Range
Dim ChDir As String
Dim NomFichier As String
Dim Site As String
Dim NomPersonne As String
Application.ScreenUpdating = False
Worksheets("Liste de dif").Activate
ChDir = Application.ActiveWorkbook.Path
Site = "Pusignan"
NomPersonne = "Suivi des demandes"
NomFichier = NomPersonne & "_" & Site
On Error GoTo Open_Outlook
Set OutApp = GetObject(, "Outlook.Application")
Open_Outlook:
If Err <> 0 Then
Set OutApp = CreateObject("Outlook.Application")
bstarted = True
End If
'On Error GoTo cleanup
For Each cell In Sheets("Liste de dif").Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And Cells(cell.Row, "F").Value = "lyon" Then
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Suivi des demandes au " & Format(Now, "dd-mmmm-yyyy")
.Body = "Bonjour " & _
vbNewLine & vbNewLine & _
"Veuillez trouver en pièce jointe l'état d'avancement du traitement de vos demandes." & _
vbNewLine & vbNewLine & _
"Vous souhaitant bonne réception," & vbNewLine & _
"Cordialement." & vbNewLine & vbNewLine & _
.Attachments.Add (ChDir & "\Archives suivi Dde" & "\" & NomFichier & "_" & Format(Now, "yy-mm-dd") & ".pdf")
.Send 'à remplacer par Send / display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
'Envoi mail => cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
Worksheets("Suivi operation").Activate
End Sub |
Partager