1 pièce(s) jointe(s)
envois par mail via VBA EXCEL
Bonjour,
Je me suis servi d'un code, en y apportant quelques modifications, dans un premier classeur Excel, et cela a fonctionné (voir code ci-dessous).
Code:
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
79
|
********************
Sub EnvoiFeuilleActiveEnPDF()
Dim NomFichier As String
Dim NomFeuille As String
Dim AnneeAujourdhui As Integer
AnneeAujourdhui = Year(Date)
Dossier = "D:\TOURNOIS A 7\" & AnneeAujourdhui & "\"
On Error Resume Next
[ATTACH=CONFIG]591115[/ATTACH]
'Affichage d'une boite de dialogue pour éventuellement changer le nom de la feuille
NomFeuille = ActiveSheet.Name
NomFichier = Application.InputBox("NOM DU FICHIER", "ENVOI DU FICHIER EN PDF", NomFeuille)
'Transformation de la feuille EXCEL en fichier PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Dossier & NomFichier, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
From:=1, To:=1, _
OpenAfterPublish:=False
'Recuperation des adresses mail dans le fichier INSCRIPTIONS
Workbooks.Open Filename:="C:\Users\toto\Documents\Modèles Office personnalisés\LRGER\Inscriptions.xlsm"
Adresse1 = Range("D6").Value
Adresse2 = Range("D7").Value
Adresse3 = Range("D8").Value
Adresse4 = Range("D9").Value
Adresse5 = Range("D10").Value
Adresse6 = Range("D11").Value
Adresse7 = Range("D12").Value
Adresse8 = Range("D13").Value
Adresse9 = Range("D14").Value
Adresse10 = Range("D15").Value
Adresse11 = Range("D16").Value
Adresse12 = Range("D17").Value
Adresse13 = Range("D18").Value
Adresse14 = Range("D19").Value
Adresse15 = Range("D20").Value
Adresse16 = Range("D21").Value
AdressesAutres = Range("D22").Value
ActiveWorkbook.Close
Dim mail As CDO.Message
Set mail = New CDO.Message
'*** Paramètrage de la messagerie LAPOSTE.NET ***
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.laposte.net"
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "toto"
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "tata"
mail.Configuration.Fields.Update
'*** Paramètrage des mails envoyés ***
With mail
.Subject = NomFeuille
.From = "toto@laposte.net"
.BCC = Adresse1 & ";" & Adresse2 & ";" & Adresse3 & ";" & Adresse4 & ";" & Adresse5 _
& ";" & Adresse6 & ";" & Adresse7 & ";" & Adresse8 & ";" & Adresse9 & ";" & Adresse10 _
& ";" & Adresse11 & ";" & Adresse12 & ";" & Adresse13 & ";" & Adresse14 & ";" & Adresse15 & ";" & Adresse16 & ";" & AdressesAutres
.CC = "toto@laposte.net"
.TextBody = "POUR INFORMATION !!! (voir fichier joint)" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Bonne reception et a bientot." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "toto"
.AddAttachment Dossier & NomFichier & ".pdf"
End With
On Error Resume Next
'Envoi des mails
mail.Send
Set mail = Nothing
End Sub
***************** |
Puis je l'ai exporté dans un autre classeur (même version d'Excel et même PC).
Et dès que je lance le code, j'ai un message que je n'ai pas dans le premier classeur (voir fichier joint)
Pourriez-vous m'expliquer ?
Merci et bonne journée.
