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
| Option Explicit
Const PourLecture = 1
Const cteAdresseSource = "bb@cc.dd"
Dim objMail, sDestination, sPieceJointeCtre, sPieceJointeCB, msgTitre, msgTexteCtre, msgTexteCB, ContenuFichierTxt, lienTb_CB, lienTb_Ctre
Set objMail = CreateObject("CDO.Message")
sDestination = aa@bb.cc
msgTitre = "mon titre"
msgTexteCtre = "Bonjour," & vbCrLf & "Voici la le premier text" & vbCrLf
msgTexteCB = "Voici un bout de text"
sPieceJointeCtre = "fichierText_Ctre.txt"
sPieceJointeCB = "fichier_Ctre"
lienTb_CB = "http://www.monsite.com"
lienTb_Ctre = "http://www.monsite.com"
With objMail
.From = cteAdresseSource
.To = sDestination
.Subject = msgTitre
.Configuration.Fields _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "monsmtp"
.Configuration.Fields _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Update
If (sPieceJointeCB <> "" & sPieceJointeCtre <> "") Then
LirePieceJointe(sPieceJointeCtre)
.TextBody = msgTexteCtre & ContenuFichierTxt & vbCrLf & lienTb_Ctre
LirePieceJointe(sPieceJointeCB)
.TextBody = .TextBody & vbCrLf & vbCrLf & vbCrLf & vbCrLf & msgTexteCB & vbCrLf & ContenuFichierTxt & vbCrLf & lienTb_CB
End If
.Send
End With
Set objMail = Nothing
WScript.Sleep 1000
'MsgBox "Courriel envoyé !"
Function LirePieceJointe(LeFichier)
Dim objFSO, CeFichier
Set objFSO = CreateObject("Scripting.FileSystemObject")
If (objFSO.FileExists(LeFichier)) Then
Set CeFichier = objFSO.OpenTextFile(LeFichier, PourLecture)
ContenuFichierTxt = CeFichier.ReadAll
CeFichier.Close
Set CeFichier = Nothing
End If
Set objFSO = Nothing
End Function |