Discussion :

[Invité]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[halaster08]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set xrg = xrg.SpecialCells(xlCellTypeConstants, xlTextValues)

Je te propose donc de remplacer cette ligne par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[MarcelG]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 With MonItem
              .To = l_dest

[Invité]

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

[MarcelG]

Salut Halaster,

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

Au demeurant
Plutôt que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
xrg.Cells.Count

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

xrg.Count

suffirait, non?

A plus tard.

[halaster08]

Salut Halaster,

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

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

Au demeurant
Plutôt que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
xrg.Cells.Count

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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:

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

[MarcelG]

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

A bientôt.