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
|
Code:
Sub envoi_mail()
Dim appOutlook As Outlook.Application
Dim mailOutlook As Outlook.MailItem
Dim emlBody1 As String, emlBody2 As String, sendTo As String
Dim wkbook As String
Dim rng As Range
Dim lastfilline As String
lastfilline = Range("J65536").End(xlUp).Row
For i = 1 To lastfilline
If Cells(i, 1).Value = "COMMENT" Then
cpty = Cells(i + 1, 10).Value
contact = Sheets("contact mail").Range("A1:B30")
Set appOutlook = New Outlook.Application
Set mailOutlook = appOutlook.CreateItem(1)
On Error Resume Next
sendTo = WorksheetFunction.VLookup(cpty, contact, 2, False)
emlBody1 = "Hi," & "<br><br>" & _
"Please confirm /infirm booking details bellow" & "<br><br>" & "Thanks" & vbCrLf & vbCrLf
emlBody2 = "Thanks" & "<br><br>"
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("ecart " & D & " " & M & " " & Y).Range(Cells(i, 1), Cells(i, 13).End(xlDown))
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With mailOutlook
'.To = sendTo
.HTMLBody = emlBody1 & RangetoHTML(rng) & emlBody2
.Subject = cpty & " Collat Break "
.Display
End With
End If
Next i
Set appOutlook = Nothing
Set mailOutlook = Nothing
End Sub |
Partager