[XL-2010] Envoi automatique de mail depuis une boîte générique Outlook

[ferreol]

Bonjour à Tous,

Je me permets de vous soumettre un petit problème que je n'arrive pas à résoudre malgré mes recherches sur le Web. J'ai adapté un code trouvé sur ce forum pour envoyer des mails automatiquement. Il fonctionne très bien (merci à son auteur). Toutefois, l'envoi des mails se fait par l'intermédiaire de mon adresse personnelle. Or j'utilise cette macro pour envoyer des newsletters à mes clients. Donc je reçois de nombreux remerciements (ce qui est plutôt sympathique), des avis d'absences, etc. Comme j'en envoie plus de 1000, les réponses s'amassent dans ma boîte de réception. Nous avons, une boite info@monentreprise.ch que j'aimerais utiliser. Y a-t-il un moyen de faire l'envoi depuis cette boîte plutôt que depuis la mienne.

Voici une partie du 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
58
59
60
61
62
63
64
65
66
67
68
Sub SendMails()
 
    Dim MonOutlook As New Outlook.Application
    Dim MyMail As MailItem
    Dim AdresseFile As String, Civilité As String, objet As String
    Dim CorpsTexte(), FichiersAttachés()
    Dim NbFichiers As Integer, NbTextes As Integer, PosDeb As Integer, PosFin As Integer, NbMsgEnvoyés As Integer, NbMsgErr As Integer
    Dim Dummy As Integer, TxtMsgBox As String, NoLigne As Double, TexteMessage As String, adresse_mail As String
    Dim Feuille As Worksheet
    Dim MailError As Boolean
 
    Set MyMail = MonOutlook.CreateItem(olMailItem)
 
(...)
'--------------------------------------------------------------------------
' Envoi du message
'--------------------------------------------------------------------------
Do While Cells(NoLigne, 4).Value <> vbEmpty
 
(...)
 
 
'--------------------------------------------------------------------------
' Création du mail
'--------------------------------------------------------------------------
 
                Set MyMail = MonOutlook.CreateItem(olMailItem)
                MyMail.To = adresse_mail                                                
                MyMail.Subject = objet                                                  
                MyMail.Body = TexteMessage                                              
                If NbFichiers > 0 Then
                    For Dummy = 1 To NbFichiers
                        MyMail.Attachments.Add (FichiersAttachés(Dummy))
                    Next Dummy
                End If
 
                On Error Resume Next
                MyMail.Send
                If Err.Number <> 0 Then
                Cells(NoLigne, 8) = "Problème: message non envoyé. " & Err.Number & " " & Err.Description
                    NbMsgErr = NbMsgErr + 1
                Else
                    Cells(NoLigne, 8) = "Envoyé"
                    NbMsgEnvoyés = NbMsgEnvoyés + 1
                End If
            End If
 
        End If
 
        NoLigne = NoLigne + 1
 
    Loop
    '--------------------------------------------------------------------------------------------------------------------------------------------------------
 
    Set MonOutlook = Nothing
 
    If NoSend = True Then
        MsgBox ("Aucun message n'a été réellement envoyé! ")
    Else
        TxtMsgBox = Format(NbMsgEnvoyés, "0") & IIf(NbMsgEnvoyés > 1, " messages envoyés.", " message envoyé.") & Chr(10)
        If NbMsgErr = 0 Then TxtMsgBox = TxtMsgBox & "Aucun message n'a généré d'erreur d'envoi"
        If NbMsgErr = 1 Then TxtMsgBox = TxtMsgBox & "Un message a généré une erreur d'envoi (cf base d'adresses)"
        If NbMsgErr > 1 Then TxtMsgBox = TxtMsgBox & Format(NbMsgErr, "0") & " messages ont généré des erreurs d'envoi (cf base d'adresses)"
        If NbMsgErr = 0 And NbMsgEnvoyés = 0 Then TxtMsgBox = "Sélectionnez les message à envoyer en indiquant un 'x' en face de l'adresse email"
        MsgBox (TxtMsgBox)
    End If
 
End Sub

Je n'ai pas mis toute la macro car je me laisse le choix du message d'accompagnement selon la personne récipiendaire, des civilités, etc. Bien évidemment, en cas d'intérêt,j e peux l'uploader.

Merci à vous tous de m'indiquer s'il existe une solution à mon problème.

Cordialement,

Pierre-Alain

[Daniel.C]

Bonjour,

Ajoute la ligne :

Code :

MyMail.SendUsingAccount = MonOutlook.Session.Accounts("info@monentreprise.ch")

après :

Code :

Set MyMail = MonOutlook.CreateItem(olMailItem)