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

[BChaly]

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

 

[Hieu]

Salut,

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

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

 

[BChaly]

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] ?

 

[Hieu]

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 ^^

 

[BChaly]

OK, C'est fait. Merci pour l'info!