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
| Sub Send_email()
Dim OutApp As Object
Dim OutMail As Object
Dim eDest As String
Dim eCC As String
Dim nom_client As String
Dim WordApp As Object
Dim WordDoc As Object
Dim MailWordDoc As Object
Dim SendFile As String
Dim DernLigne As Long
Dim ligne As Integer
DernLigne = Sheets("TRI").Range("X1048576").End(xlUp).Row
Set OutApp = CreateObject("Outlook.Application")
OutApp.session.logon
SendFile = "P:\Document\IMMOBILIER\EMAIL\TEST.docx"
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(SendFile)
WordApp.Selection.WholeStory
WordDoc.Content.Copy
'On Error Resume Next
For ligne = 2 To DernLigne
eDest = Sheets("TRI").cells(ligne, 5).Value
eCC = Sheets("TRI").cells(ligne, 7).Value
nom_client = Sheets("TRI").cells(ligne, 2) & " " & Sheets("TRI").cells(ligne, 4).Value
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = eDest
.CC = eCC
.BCC = ""
.Subject = "PROPOSITION D'INVESTISSEMENT IMMOBILIER"
'.BodyFormat = olFormatHTLM
.HTMLBody = "Bonjour " & nom_client & " ," & "<br>" & "<br>" _
If Len(piece_jointe) > 0 Then
.Attachments.Add piece_jointe
End If
.Display
End With
Set MailWordDoc = OutApp.ActiveInspector.WordEditor
MailWordDoc.Application.Selection.Paste
Next ligne
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
WordDoc.Close
WordApp.Quit
End Sub |
Partager