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
| Public Function SMTPSendMail(pstrTo As String, pstrSubject As String, Optional pvarAttachFile As Variant) As Boolean
On Error GoTo SMTPSendMail_Err
Dim i As Long
Dim objEmail As New CDO.Message
'Set objEmail = CreateObject("CDO.Message")
objEmail.From = MAIL_FROM
objEmail.To = pstrTo
objEmail.Subject = pstrSubject
' Aucun corps de message, uniquement la pièce jointe
' laisser un TextBody avec chaine vide, sinon le mail peut planter (pièce jointe incomplète)
objEmail.TextBody = ""
' Ajout de la pièce jointe, 1 ou plusieurs fichiers
If Not IsMissing(pvarAttachFile) Then
If IsArray(pvarAttachFile) Then
' parcourrir le tableau
For i = LBound(pvarAttachFile) To UBound(pvarAttachFile)
objEmail.AddAttachment pvarAttachFile(i)
Next i
Else
objEmail.AddAttachment pvarAttachFile ' "C:\temp\Bon de commande.pdf"
End If
End If
With objEmail.Configuration.Fields
.Item(CdoConfiguration.cdoSendUsingMethod) = MAIL_SENDUSING
.Item(CdoConfiguration.cdoSMTPAuthenticate) = MAIL_AUTHENTICATE
.Item(CdoConfiguration.cdoSendUserName) = MAIL_CPT_SENDUSR
.Item(CdoConfiguration.cdoSendPassword) = MAIL_CPT_SENDPASS
.Item(CdoConfiguration.cdoSMTPServer) = MAIL_SMTP_SERVER
.Item(CdoConfiguration.cdoSMTPServerPort) = MAIL_SMTP_SERVERPORT
.Update
End With
objEmail.Send
SMTPSendMail = True
Exit Function
SMTPSendMail_Err:
MsgBox Err.Description
End Function |
Partager