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
| Private Sub CBEnvoiMailPersonnalisé_Click()
Dim I As Integer
Dim LesContacts As String
Dim OutApp As Object, OutMail As Object
If VérificationConnexionInternet = False Then
MsgBox "Vous n'êtes pas connecté à internet !", vbInformation, "Pas de connexion internet"
Exit Sub
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Application.ActivateMicrosoftApp (xlMicrosoftMail)
With Me.LBListeContacts
For I = 0 To .ListCount - 1
If .Selected(I) = True Then LesContacts = LesContacts & ";" & Mid(.List(I), InStr(1, .List(I), ":") + 2)
Next I
End With
With OutMail
.To = Mid(LesContacts, 2)
.Subject = TBObjet.Value
.HTMLBody = "<pre><Font size=3 Face=" & """ Times New Roman """ & ">" & TBMessage.Text & "</pre>" & "<br>" & "<img src=" & ExecuteExcel4Macro("'" & CheminDossierDevisFacturation & "[Modèle.xlsm]Données'!R4C24") & ">" & "<br>" & "<br>" & "<br>" & "<img src=" & ExecuteExcel4Macro("'" & CheminDossierDevisFacturation & "[Modèle.xlsm]Données'!R5C24") & ">"
For I = 0 To Me.LBListePièceJointe.ListCount - 1
.Attachments.Add Me.LBListePièceJointe.List(I, 1)
Next I
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Partager