Sub envoi_Tech()
1 Dim CdoMessage As Object
2 Dim Fichier As Variant
3 On Error GoTo erreurtransport
4 ESubject = Worksheets("Donnees").Range("A8").Value
5 Fromo = Worksheets("Donnees").Range("A10").Value
6 SendTo = Worksheets("Donnees").Range("A10").Value
7 BCCto = Worksheets("Donnees").Range("A10").Value
8 Ebody = Worksheets("Donnees").Range("D6").Value & Chr(10) & Worksheets("Donnees").Range("I6").Value & Chr(10) & Worksheets("Donnees").Range("K6").Value
10 Set CdoMessage = CreateObject("CDO.Message")
11 With CdoMessage
12 .Subject = ESubject
13 .From = Fromo
14 .To = SendTo
15 .Bcc = BCCto
16 .TextBody = Ebody
17 .AddAttachment NewFileName
18 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
19 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "srv-msgch1.sogetrel.fr"
20 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
21 .Configuration.Fields.Update
22 .Send
End With
Sheets("Donnees").Range("A4") = DateValue(Now)
24 Set CdoMessage = Nothing
Exit Sub
25 erreurtransport:
Application.Wait Now + TimeSerial(0, 0, 5)
26 Resume
27 End Sub