[XL-2007] Problème/code envoi mail avec serveur Microsoft Exchange

Problème/code envoi mail avec serveur Microsoft Exchange

Salut le forum

Permettez que je soumette un problème sur le fonctionnement d'un de mes codes que je ne comprend vraiment pas.
le problème a commencé le jour ou nous avons basculé sur Microsoft Exchange.
Je ne sais pas si le code a besoin d'être adapté à ce nouveau serveur.
Je vous laisse l'apprécier pour pouvoir profiter de vos multiples expériences.
Ci-dessous le code:

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
Option Explicit
 Sub Envoi_Mail()
 ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
 ' This example sends the last saved version of the Activeworkbook object .
     Dim OutApp As Object
     Dim OutMail As Object
     Dim texte As String
     Dim i As String
     Dim Nomfic As String, spath As String, Nomfic1 As String, spath1 As String, spath2 As String, nomfic2 As String, spath3 As String, nomfic3 As String
     spath = Environ("USERPROFILE")
     spath1 = Environ("USERPROFILE")
     spath2 = Environ("USERPROFILE")
     spath3 = Environ("USERPROFILE")
     spath = spath & "\bureau\SGIIOC+\"
     spath1 = spath1 & "\bureau\SGIIOC+\"
     spath2 = spath2 & "\bureau\SGIIOC+\"
     spath3 = spath3 & "\bureau\SGIIOC+\"
     Nomfic = Sheets("parametre").Range("A107").Value
     Nomfic1 = Sheets("parametre").Range("A108").Value
     nomfic2 = Sheets("parametre").Range("A109").Value
     nomfic3 = Sheets("parametre").Range("A1010").Value
 
    Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)
     i = Range("C35").Value
     texte = texte & Sheets("PF").Range("C74").Value & " le, " & Date & vbCrLf & vbCrLf
     texte = texte & "A" & vbCrLf
 texte = texte & Sheets("parametre").Range("AO2").Value & vbCrLf
 texte = texte & Range("C32").Value & vbCrLf
 texte = texte & Sheets("parametre").Range("U98").Value & vbCrLf & vbCrLf & vbCrLf
 
    On Error Resume Next
 
    With OutMail
         .To = Range("C35").Value
         .CC = ""
         .BCC = ""
         .Subject = "Bienvenue dans votre Banque"
         .Body = texte
         .Attachments.Add spath & Nomfic
         .Attachments.Add spath1 & Nomfic1
         .Attachments.Add spath2 & nomfic2
         .Attachments.Add spath3 & nomfic3
 
        ' You can add other files by uncommenting the following line.
         '.Attachments.Add ("C:\users/benzoplus/desktop/lm bad.pdf")
         'Ex:.Attachments.Add ("C:\users/benzoplus/desktop/lm bad.pdf")
         ' In place of the following statement, you can use ".Display" to
         ' display the mail.
         .Send
     End With
     On Error GoTo 0
 
    Set OutMail = Nothing
     Set OutApp = Nothing
 
End Sub

Bonjour Capi81

Apparemment tu fonctionnais déjà avec Outlook, donc je suis étonné que tu es un problème !?

Quel est le message d'erreur ?

A+

Salut BrunoM45

Merci pour feedback.
Aucun message ne s'affiche mais.
Lorsque je rentre dans ma boite d'envoi, je ne retrouve pas le message.
Le destinataire ne le recoit pas aussi.
Voici comment j'appel la macro E_MAil à partir d'une commande de mon usf (voir code ci-dessous):
Code:

1 2 3 Sub E_Mail If Not InStr(1, Worksheets("DONNE").Range("C35").Value, "@") > 0 Then Exit Sub Call Envoi_Mail

Re,

As-tu essayé de passer en mode débogage pour voir ce qui ce passait !?

Dans ta Sub Email, tu mets
Code:

1 2 3 4 5 Sub E_Mail() Stop ' Ici le débogueur s'active If InStr(1, Worksheets("DONNE").Range("C35").Value, "@") = 0 Then Exit Sub Call Envoi_Mail End Sub
Il suffit d'appuyer sur la touche [F8] pour savoir ce que fait ton code
Positionne le curseur de la souris sur les instructions pour connaitre leur contenu

A+