XL 2016 Envoi d'emails en VBA avec un "objet" différent [Résolu]

BChaly

XLDnaute Occasionnel
Bonsoir,

Le code VBA que j’utilise fonctionne très bien (avec Outlook) pour envoyer plusieurs emails en une seule fois à des clients différents dont les adresses figurent dans la colonne «C» de la feuille «Commandes».

Pour chaque email je souhaiterais reporter automatiquement l’objet figurant dans la colonne «D».

Comment pourrais-je adapter ce code (voir pièce jointe)?

Merci pour votre aide.

Cordialement,

BChaly
 

Fichiers joints

Hieu

XLDnaute Impliqué
Salut,

Il faut recuperer les objets dans une variable à mettre à .Subject:

VB:
Sub EnvoiEmails()

    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Object
    Dim xMailOut As Object
   
On Error Resume Next
   
    xAddress = ActiveWindow.RangeSelection.Address
        Set xRg = Application.InputBox("Sélection adresse(s) email(s)", "Envoi email(s)", xAddress, , , , , 8)
            If xRg Is Nothing Then Exit Sub
           
Application.ScreenUpdating = False
   
    Set xOutApp = CreateObject("Outlook.Application")
        Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
            For Each xRgEach In xRg
                xRgVal = xRgEach.Value
                sujet = Range("d" & xRgEach.Row) ' modif
                    If xRgVal Like "?*@?*.?*" Then
                        Set xMailOut = xOutApp.CreateItem(olMailItem)
                            With xMailOut
                                .To = xRgVal
                                .Subject = sujet ' et ici
                                .Body = "Cher Client, " _
                                    & vbNewLine & vbNewLine & _
                                    "BlaBlaBla....................." _
                                    & vbNewLine & _
                                    "Sincères salutations" _
                                    & vbNewLine & _
                                    "Signature" _
                       
                                .Display
                                '.Send
                            End With
                    End If
            Next
        Set xMailOut = Nothing
    Set xOutApp = Nothing
   
Application.ScreenUpdating = True

End Sub
 

Fichiers joints

BChaly

XLDnaute Occasionnel
Bonjour Hieu,

Genial!!! C'est exactement ce que je cherchais.

Merci mille fois!!!

Cordialement,

BChaly


PS: Comment dois-je modifier le post en [Résolu] ?
 
Dernière édition:

Hieu

XLDnaute Impliqué
Tu mets [RESOLU] au bout du titre, j'ai pas mieux.
En fait, j'avais mis ca pour les gens, quand ils font des recherches, quand le sujet est resolu, on peut laisser supposer que la rep est dans cette discussion.

Faut j'vire ma signature, j'sais plus comment on fait ^^
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas