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
|
Private Sub Bt_Envoyer_Mail_Click()
Dim NewMail As CDO.Message
'création d'1 copie PDF sur le bureau
ActiveDocument.ExportAsFixedFormat OutputFileName:=Environ$("USERPROFILE") & "\Bureau\testpdf.pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
'MsgBox "Une copie PDF a été créée sur votre bureau..." & Chr(10) & "Merci de patienter :" & Chr(10) & "elle est en cours de transfert vers xxxxxx"
Set NewMail = New CDO.Message
'Enable SSL Authentication
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Make SMTP authentication Enabled=true (1)
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'Set the SMTP server and port Details
'To get these details you can get on Settings Page of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Set your credentials of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxxxxx@xxxx"
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx"
NewMail.Configuration.Fields.Update
'Set All Email Properties
With NewMail
.Subject = "xxxx"
.From = "xxx"
.To = "xxx"
.CC = "xxxxxx"
.BCC = "xxxxxxx"
.textbody = "xxxxxx"
.AddAttachment Environ$("USERPROFILE") & "\Bureau\testpdf.pdf"
End With
NewMail.Send
MsgBox ("Le formulaire a été envoyé")
'Set the NewMail Variable to Nothing
Set NewMail = Nothing
End Sub |
Partager