Discussion :

[ericdev67]

Bonjour,

Je cherche à envoyer automatiquement un mail via OUTLOOK, j'ai le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub envoi()
 
Dim chemin As String
Dim lettre As String
Dim sDossier As String
 
Dim appoutlook As Outlook.Application
Dim nomcons As String
Dim monmessage As Object
Dim texte As String
Set appoutlook = New Outlook.Application
Set monmessage = appoutlook.createitem(olmailitem)
Dim c, e As Integer
Dim adressedestinataire As String
Dim daterelance As String
Dim d As String
Dim dn As String
Dim dp As String
Dim dl As Range
Dim Dligne As Integer
Dim derniere As Integer
Dim i As Integer
Dim ligne As Long
Dim cons As String
Dim motif As String
 
 
 
 
ligne = ActiveCell.Row
 
 
For i = 1 To 50
 
If Sheets("Totaux").Cells(ligne, 17) = Sheets("Base").Cells(i, 30) Then cons = Sheets("Base").Cells(i, 32)
 
Next
 
 
If (Sheets("Totaux").Cells(ligne, 50) <> "") Then motif = "Accord "
If (Sheets("Totaux").Cells(ligne, 51) <> "") Then motif = "Refus "
 
 
adressedestinataire = cons
 
With monmessage
.To = adressedestinataire
.Subject = "Dossier : " & Sheets("Totaux").Cells(ligne, 3) & " " & Sheets("Totaux").Cells(ligne, 4) & " - " & Sheets("Totaux").Cells(ligne, 2)
'texte = motif
.HTMLBody = motif 'texte
.Display
 
End With
 
 
 
Application.DisplayAlerts = False
End Sub

Tout fonctionne, mais OUTLOOK s'ouvre et je suis "obligé" de cliquer sur "envoyer" pour envoyer le mail.

N'y aurait-il pas un moyen (code VBA) pour envoyer automatiquement le mail = lorsque je lance "envoi()", le mail part automatiquement, sans passer par une ouverture et/ou validation de Outlook ?? (il s'agit juste d'un message si le dossier x est accepté ou refusé….

Merci,

A+

[jijie]

Bonsoir,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Sub EnvoiAutomatiqueMail()
Public Sub EnvoiAutomatiqueMail()
Dim OutlookApp As Object
Dim OutlookMail As Object
 
 
   On Error GoTo EnvoiAutomatiqueMail_Error
 
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
 
 ' pour choisir l'expéditeur : http://www.developpez.net/forums/d1315835/logiciels/microsoft-office/excel/macros-vba-excel/envoyer-email-from-expediteur/
'.from = Sheets("Accueil").Range("g11") 'AdresExpediteur
 
.SentOnBehalfOfName = Sheets("Accueil").Range("g11") ' force AdresExpediteur si pas outlook propriétaire
.Subject = "SuJet"
.To = "aaa@bbb.com"
.Body = "message"
 
 
'If doSSier <> "" Then .Attachments.Add doSSier
'If Sheets("feuil2").Range("b13") = False Then .Display '   Ici on peut supprimer pour l'envoyer sans vérification
 .Send 'sans autorisation
'.Send "%{s}", True
 
End With
 
 
   On Error GoTo 0
   Exit Sub
 
EnvoiAutomatiqueMail_Error:
 
  MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure EnvoiAutomatiqueMail of Module Mail"
 
End Sub

voili voila!

[ericdev67]

Merci jijie,

Ton code permet effectivement l'envoi sans l'ouverture de Outlook et la validation "envoyer".

par contre, j'ai un message "Un programme tente d'envoyer automatiquement du courrier éléctronique en votre nom, l'autorisez vous à poursuivre ?"

J'ai essayé de l'enlever en mettant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.DisplayAlerts = false

et j'ai aussi essayé avec "True", mais j'ai toujours ce message....

Impossible d'enlever ce message ?

Merci,

A+

[jijie]

et sans inscrire l'adresse expéditeur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Sub EnvoiAutomatiqueMail()
Dim OutlookApp As Object
Dim OutlookMail As Object
 
 
   On Error GoTo EnvoiAutomatiqueMail_Error
 
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
 
 ' pour choisir l'expéditeur : http://www.developpez.net/forums/d1315835/logiciels/microsoft-office/excel/macros-vba-excel/envoyer-email-from-expediteur/
 
.Subject = "SuJet"
.To = "aaaa@bbb.com"
.Body = "message"
 
 
'If doSSier <> "" Then .Attachments.Add doSSier
'If Sheets("feuil2").Range("b13") = False Then .Display '   Ici on peut supprimer pour l'envoyer sans vérification
 .Send 'sans autorisation
'.Send "%{s}", True
 
End With
 
 
   On Error GoTo 0
   Exit Sub
 
EnvoiAutomatiqueMail_Error:
 
  MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure EnvoiAutomatiqueMail of Module Mail"
 
End Sub

[ericdev67]

Merci jijie,

Idem......: même message.....

A+

[jijie]

Bon chez moi ça fonctionne ds les deux versions , je travaille avec XP

Pour moi il te reste que la solution d'envoyer sans Outlook !

si tu le souhaite je pourrais t'envoyer une ébauche!

[ericdev67]

Merci jijie,

Je suis aussi sous XP, mais il est possible qu'avec les "antivirus" (=ordinateur du boulot) il y ait blocage…..

J'accepte volontiers ta proposition de nouvelle piste….

A+

[jijie]

Bonsoir eric

Bon je te laisse une version réalisé avec essai limité ( bcp de copier collé) mais bon c'est pour l'exemple

Le principe est :
1 - pour les adresses expéditeur, destinataire, et CCI tu as libre choix !

2 - pour le fournisseur d'accès tu dois choisir en fonction du fournisseur d'accès (FAI) d'ou tu envoi (ex si la box est d'orange alors choisir Orange!)

à toi d'adapter !

Je pense avoir remarqué que PatrickToulon à une contribution sur ce sujet,

Je ne sais pas ce que ça donne sur un réseau, je voulais l'essayer en déplacement mais je n'en pas pris le temps! Si c'est ton cas donne moi des nouvelles !

a+


Pièce jointe 138558

[ericdev67]

Nickel Jijie,

Je l'ai testé sur mon ordi perso et cela fonctionne nickel (après adaptation) !!!

Merci !

Je vais voir quel est le FAI de mon boulot et je l'adapterai…

Merci pour cette idée, simple et qui fonctionne !

Merci,

A+ pour de prochaines aventures…..