Envoyer un mail à un destinataire variable via outlook

bonjour à tous,

Après plusieurs recherches infructueuses, je me lance à vous demander de l'aide.
J'ai un fichier Excel a partir duquel je peux envoyer un mail à plusieurs destinataires lors de son enregistrement.
Cette macro fonctionne correctement à partir de 2 destinataires et plus. Seulement lorsque je souhaite l'envoyer à un destinataire unique ça ne fonctionne pas et un mail est généré pour tous les destinataires du fichier.

Je souhaiterais pouvoir envoyer un mail à un seul ou plusieurs destinataires en ayant la possibilité de sélectionner les adresses sur la feuille Excel comme c'est déjà le cas dans ma macro actuelle avec l'outil "KuTool for Excel".

Je met ci-dessous mon code actuel qui fonctionne pour plusieurs destinataires.

J'espère être assez précise dans ma demande.

Merci à tous pour votre aide.

Marion

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

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)   If MsgBox("Voulez-vous envoyer un mail de mise à jour?", vbYesNo, "Mail d'information") = vbYes Then   Sheets("validations").Select     Dim xRg As Range Dim xRgEach As Range Dim xRgVal As String Dim xAddress As String Dim xOutApp As Object Dim oItem As Object Const olMailItem As Long = 0   On Error Resume Next xAddress = ActiveWindow.RangeSelection.Address Set xRg = Application.InputBox("Selectionner les adresses a envoyer", "KuTools For Excel", xAddress, , , , , 8) If xRg Is Nothing Then Exit Sub Application.ScreenUpdating = False Set xOutApp = CreateObject("Outlook.Application") Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues) Set oItem = xOutApp.createItem(olMailItem) For Each xRgEach In xRg xRgVal = xRgEach.Value If xRgVal Like "?*@?*.?*" Then Set xMailOut = xOutApp.createItem(olMailItem) With xMailOut .To = xRgVal .Subject = "Mise à jour du fichier projet " & Range("B1") & "" .Body = "Le fichier projet " & Range("B1") & " a été complété" _   .Display '.Send End With End If Next Set xMailOut = Nothing Set xOutApp = Nothing Application.ScreenUpdating = True   End If   End Sub

---

Bonjour,

En lançant ton code en mode pas à pas (F8), on remarque que le problème vient de cette instruction:

Code:

---

Set xrg = xrg.SpecialCells(xlCellTypeConstants, xlTextValues)

---

Je te propose donc de remplacer cette ligne par:

Code:

---

If xrg.Cells.Count > 1 Then Set xrg = xrg.SpecialCells(xlCellTypeConstants, xlTextValues)

---

Bonjour Marion.
Sois la bienvenue sur ce Forum.

Pour envoyer, un seul mail à plusieurs destinataires, tu peux effectuer une boucle pour alimenter une chaine de caractères

Code:

---

1 2 3 4 5

Dim l_dest as String, c as Range l_dest = "" For Each c In Worksheets(1).Range("A1:A5") l_dest = l_dest & Trim(.Value) & ";" Next c

---

A adapter avec une condition possible sur les valeurs de c

La propriété "To" de l'item Outlook serait alors informée ainsi

Code:

---

1 2	With MonItem .To = l_dest

---

Bonjour,

Merci halaster08 , ta solution fonctionne à merveille!
MarcelG , merci pour ta réponse!

Et surtout merci à tous les deux pour vos réponses rapide!

Bonne journée,

Marion

Salut Halaster,

C'est la 1ère fois que je vois 2 arguments dans la propriété SpecialCells.

Au demeurant
Plutôt que

Code:

---

1 2	xrg.Cells.Count

---

Code:

---

xrg.Count

---

suffirait, non?

A plus tard.

Citation:

---

Envoyé par MarcelG

Salut Halaster,

C'est la 1ère fois que je vois 2 arguments dans la propriété SpecialCells.

---

:salut:
Moi aussi, la ligne de code n'est pas de moi

Citation:

---

Au demeurant
Plutôt que

Code:

---

1 2	xrg.Cells.Count

---

Code:

---

xrg.Count

---

suffirait, non?

---

C'est possible, je précise .cells pour être sûr de ce que je compte.
Quand je lis l'aide Microsoft:

Citation:

---

Envoyé par docs.microsoft.com

Propriété Range.Count (Excel)
Cette propriété renvoie une valeur de type Long qui représente le nombre d'objets de la collection.

---

En écrivant range.count je ne suis pas sûr de quelle collection il utilise, donc dans le doute je précise.
Est-ce vraiment utile ? Je ne sais pas, mais c'est pas beaucoup plus long à écrire et ça me tranquilise

Si c'est sûr.:P
La propriété Count peut s'affecter à tout type d'objet Range (SpecialCells, Union...)

A bientôt.:salut: