Question envoie de mail automatique cellules variables

Bonjour à tous !

J'ai une question assez précise sur une partie de code d'envoie de mail automatique (la partie en question est à la fin du code en gras).

Enfaite j'envoie souvent des mails à des destinataires variables, de modèle de machines variables avec une adresse variable.

Sur mon Excel tout est sur la même ligne, et je souhaite que lorsque je clique sur la la catégorie "destinataire" le contenu de la cellule sélectionnée (l'adresse mail) soit mis en destinataire dans le mail (chose que j'arrive à faire ). Cependant je souhaite que les 2 cellules sur la même ligne (colonne différente mais toujours identique) soient aussi mis dans le contenu de mon mail ( il s'agit du modèle et de l'adresse de la machine).

Ma demande est assez spécifique mais je galère vraiment à le faire, si quelqu'un me donne une solution je serai vraiment reconnaissant ! J'espère que les cerveaux sont de la partie ! Je vous remercie d'avance

Voici le code :

Sub Insta(ByVal Sujet As String, ByVal Destinataire As String, ByVal ContenuEmail As String, Optional ByVal PieceJointe As String)

On Error GoTo InstaErreur

'définition des variables

Dim oOutlook As Outlook.Application

Dim WasOutlookOpen As Boolean

Dim oMailItem As Outlook.MailItem

Dim Body As Variant

Body = ContenuEmail

'vérification si le Contenu du mail n'est pas vide. Si oui, email n'est pas envoyé.

If (Body = False) Then

MsgBox "Mail non envoyé car vide", vbOKOnly, "Message"

Exit Sub

End If

'préparer Outlook

PreparerOutlook oOutlook

Set oMailItem = oOutlook.CreateItem(0)

'création de l'email

With oMailItem

.To = Destinataire

.Subject = Sujet

'CHOIX DU FORMAT

'----------------------

'email formaté comme texte

.BodyFormat = olFormatRichText

.Body = Body

'OU

'email formaté comme HTML

'.BodyFormat = olFormatHTML

'.HTMLBody = "<html><p>" & Body & "</p></html>"

'----------------------

If PieceJointe <> "" Then .Attachments.Add PieceJointe

.Display '<- affiche l'email

'.Save '<- sauvegarde l'email avant l'envoi

'.Send '<- envoie l'email

End With

'nettoyage...

If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing

If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

Exit Sub

InstaErreur:

If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing

If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"

End Sub

Private Sub PreparerOutlook(ByRef oOutlook As Object)

'------------------------------------------------------------------------------------------------

'Ce code vérifie si Outlook est prêt à envoyer des emails...

'------------------------------------------------------------------------------------------------

On Error GoTo PreparerOutlookErreur

On Error Resume Next

'vérification si Outlook est ouvert

Set oOutlook = GetObject(, "Outlook.Application")

If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte

Err.Clear

Set oOutlook = CreateObject("Outlook.Application")

Else 'si Outlook est ouvert, l'instance existante est utilisée

Set oOutlook = GetObject("Outlook.Application")

oOutlook.Visible = True

End If

Exit Sub

PreparerOutlookErreur:

MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."

End Sub

Sub TestInsta_Variables()

'définition des variables

Dim MonSujet As String

Dim MonDestinataire As String

Dim MonContenu As String

Dim MaPieceJointe As String

'attribution des valeurs aux variables

MonSujet = "DEMANDE PARTICULIERE"

MonContenu = "Bonjour, Peux tu regarder " & MODELE DE LA MACHINE QUI EST TOUT LE TEMPS SUR LA MÊME COLONE, ET SUR LA MEME LIGNE QUE LA CELLULE SELECTIONNEE &" "A l'adresse "& ADRESSE QUI EST TOUT LE TEMPS SUR LA MEME COLONE ET SUR LA MEME LIGNE QUE LA CELLULE SELECTIONEE".

MonDestinataire = ActiveCell

'test envoi de l'email

Call EnvoyerEmail(MonSujet, MonDestinataire, MonContenu, MaPieceJointe)

End Sub

Bonjour,

Exemple pour prendre les valeurs des cellules en colonne c ET d

'attribution des valeurs aux variables

MonSujet = "DEMANDE PARTICULIERE"
MonContenu = "Bonjour, Peux tu regarder " & Cells(ActiveCell.Row, "C") & " A l'adresse " & cells(ActiveCell.Row, "D")
MonDestinataire = ActiveCell

Merci pour ta réponse, ça fonctionne ! Par contre tu saurais comment concatèner un retour a ligne à la suite ? Exemple ci-après (ça ne passe pas comme ça). ( je n'oublie pas de le mettre en résolu )

'attribution des valeurs aux variables

MonSujet = "DEMANDE PARTICULIERE"

MonContenu = "Bonjour, Peux tu regarder " & Cells(ActiveCell.Row, "C") & Chr(10) " A l'adresse " & cells(ActiveCell.Row, "D")

MonDestinataire = ActiveCell

bonjour,

chr(10) pour un retour à la ligne en richtext

"<br>" pour un retour à la ligne en HTML

Rechercher des sujets similaires à "question envoie mail automatique variables"