Envoie d'email via l'adresse mail inscrite dans la cellule

Bonjour à tous,

J'ai un petit soucis sur un programme que voici :

Sub envoiClasseur()

Dim Fichier As Variant

'Identification d'Outlook comme client de messagerie"

Dim MaMessagerie As Object

Dim MonMessage As Object

Set MaMessagerie = CreateObject("Outlook.application")

Set MonMessage = MaMessagerie.CreateItem(0)

'Destinataires du mail'

MonMessage.to = Range("M7") <------------ (c'est à ce niveau )

'identification du fichier ouvert à envoyer'

MonMessage.Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

'Sujet du mail'

MonMessage = "Test envoi message"

'Corps du mail'

'Chr(10) & Chr(13)= saut de ligne"

contenu = "Bonjour,"

contenu = contenu & Chr(10) & Chr(13)

'Chr indiquent des sauts de lignes'

contenu = contenu & "Veuillez trouver en PJ le rapport d'activité" & Chr(10) & Chr(13)

contenu = contenu & "Cordialement" & Chr(10) & Chr(13)

contenu = contenu & " "

MonMessage.body = contenu

'envoi du message'

MonMessage.send

'réinitalisation de la messagerie'

Set MaMessagerie = Nothing

'Boite de dialogue"

MsgBox "Votre message a bien été envoyé"

End Sub

Le but de ce programme est d'envoyer un mail en appuyant sur un bouton une fois que j'ai fini le rapport que je doit remplir quotidiennement. (gain de temps pour l'envoyer à mon responsable)

J'aimerais sélectionner l'adresse mail du destinataire que j'ai inscrite dans la cellule sur excel (sur mon document elle est situé cellule M7 et dedans c'est marqué (par ex) xxxxxxx@xxx.fr)

Mais en reprenant mon programme, via la cellule, l'envoie ne se fait pas... ET par contre en indiquant l'adresse mail directement dans le VBA, ça fonctionne.

C'est tout simplement pour : si un intérimaire viens prendre un rapport vierge, il aura juste à aller mettre son email dans la fameuse cellule M7 au lieu d'aller modifier dans le VBA

Si quelqu'un pourrais m'aider, ce serais cool !

Merci à vous

Joyeuse fêtes

Bonjour,

Je ne vois pas d'erreur, donc à tout hasard, la feuille où se trouve M7 est-elle la feuille "active" ?

MonMessage = "Test envoi message"

mettre aussi

MonMessage.Subject = "Test envoi message"

Merci pour ta réponse !

Hum ... donc je ne peux rien faire.

Essaie de changer d'ordinateur si tu peux.

Es-ce un problème de paramétrage outlook, voire office ?

Ecris quand même ceci :

MonMessage.Subject = "Test envoi message"

car ta syntaxe n'était pas correcte.

Bonjour,

Une proposition à étudier.

ALT F8, exécuter la procédure.

Cdlt.

Option Explicit

Public Sub SendMail()
Dim MaMessagerie As Object, MonMessage As Object
Dim Destinataire As String, Contenu As String

    Set MaMessagerie = CreateObject("Outlook.application")
    Set MonMessage = MaMessagerie.CreateItem(0)
    MaMessagerie.Session.Logon

    Destinataire = ActiveSheet.Cells(7, 13).Value

    Contenu = "Bonjour,"
    Contenu = Contenu & Chr(10) & Chr(13)
    Contenu = Contenu & "Veuillez trouver en PJ le rapport d'activité" & Chr(10) & Chr(13)
    Contenu = Contenu & "Cordialement" & Chr(10) & Chr(13)

    With MonMessage
        .To = Destinataire
        .CC = ""
        .BCC = ""
        .Subject = "Test envoi message"
        .Body = Contenu
        .Attachments.Add ActiveWorkbook.FullName
        .Display    '.Send pour envoi sans affichage Outlook

    End With

    Set MonMessage = Nothing: Set MaMessagerie = Nothing

End Sub

Merci beaucoup Jean-Eric ! ton programme marche très bien !

Par contre j'ai voulu ajouter une msg box voulant confirmer l'envoie du mail par oui ou par non :

Public Sub SendMail()

Dim MaMessagerie As Object, MonMessage As Object

Dim Destinataire As String, Contenu As String

Set MaMessagerie = CreateObject("Outlook.application")

Set MonMessage = MaMessagerie.CreateItem(0)

Destinataire = ActiveSheet.Cells(7, 13).Value

destinataire1 = ActiveSheet.Cells(11, 13).Value

Contenu = "Bonjour,"

Contenu = Contenu & Chr(10) & Chr(13)

Contenu = Contenu & "Veuillez trouver en PJ le rapport d'activité "

Contenu = Contenu & Format(Date, "dd-mm-yyyy") & Chr(10) & Chr(13)

Contenu = Contenu & "Cordialement" & Chr(10) & Chr(13)

With MonMessage

.To = Destinataire

.CC = destinataire1

.BCC = ""

.Subject = "Rapport d'activité"

.Body = Contenu

.Attachments.Add ActiveWorkbook.FullName

.Send

If MsgBox("Etes-vous certain de vouloir envoyer le mail ?", vbYesNo, "Demande de confirmation") = vbYes Then

MsgBox "Le mail à été envoyé !"

End If

End With

Set MaMessagerie = Nothing

End Sub

Le soucis c'est que quand on clique sur Non, le message s'envoie quand même...

J'ai essayé plein de trucs mais ça n'a jamais marché

Mets le .Send après le If

Jean-Eric & Tapierre

J'aurais bien aimé comprendre ce qui ne fonctionnait pas dans le programme initial, à part MonMessage.Subject que j'avais signalé ...

@ Tapierre : avais-tu essayé ?

Il est vrai que l'écriture que t'a proposée Jean-Eric est plus élégante et formatée.

Oui j'ai essayé et ça ne marchais pas non plus.

A moins que j'ai mal compris tes réponses...

Mets le .Send après le If

J'ai pas compris en fait, quel If ?

If MsgBox("Etes-vous certain de vouloir envoyer le mail ?", vbYesNo, "Demande de confirmation") = vbYes Then
.Send

MsgBox "Le mail à été envoyé !"
End If

ça fait erreur pour le oui (erreur automation)

Mais le non marche du coup

tu as aussi une solution beaucoup plus simple : remplace .send par .display et tu auras la main dans outlook pour envoyer, enregistrer le brouillon ou annuler

Re,

Une variante avec le message de confirmation.

Cdlt.

Public Sub SendMail()
Dim MaMessagerie As Object, MonMessage As Object
Dim Destinataire As String, Contenu As String, Copie As String
Dim Reponse As VbMsgBoxResult

    Reponse = MsgBox("Veuillez confirmer l'envoi du courriel...", vbYesNo, "Envoi courriel")
    Select Case Reponse
        Case vbYes
            Set MaMessagerie = CreateObject("Outlook.application")
            Set MonMessage = MaMessagerie.CreateItem(0)
            'MaMessagerie.Session.Logon ---> pas nécessaire !?
            Destinataire = ActiveSheet.Cells(7, 13).Value
            Copie = ActiveSheet.Cells(11, 13).Value
            Contenu = "Bonjour,"
            Contenu = Contenu & vbCrLf
            Contenu = Contenu & "Veuillez trouver en PJ le rapport d'activité" & vbCrLf
            Contenu = Contenu & "Cordialement" & vbCrLf
            With MonMessage
                .To = Destinataire
                .CC = Copie
                .BCC = ""
                .Subject = "Test envoi message"
                .Body = Contenu
                .Attachments.Add ActiveWorkbook.FullName
                .Display    '.Send pour envoi sans affichage Outlook
                '.send
            End With
            MsgBox "Le courriel à été envoyé", vbOKOnly + vbInformation, "Confirmation"
            Set MonMessage = Nothing: Set MaMessagerie = Nothing
        Case Else
            Exit Sub
    End Select

End Sub

Merci beaucoup Jean Eric, ça marche impeccable !

Merci à toi aussi Steelson, tu m'a appris des choses également !

Je vous souhaites de bonnes fêtes

à bientot

... du coup, mois aussi j'ai appris des choses avec le code de Jean-Eric

Merci

Rechercher des sujets similaires à "envoie email via adresse mail inscrite"