Microsoft 365 VBA Création Question liste destinataire

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Chaton0408

XLDnaute Nouveau
Bonjour,

Je suis entrain d’apprendre à me développer sur Excel et j’ai un problème pour le fichier de mon travail - voici la VBA ci dessous :

- Je souhaiterais envoyer un e-mail automatique lorsqu’une information est modifiée dans une des cellules des colonnes de J à M mais que cela envoie un e-mail uniquement aux deux adresses emails listées dans la colonne D et E.
Donc si par exemple il y a une modification en J1 cela devrait envoyer un e-mail à D1 et E1 etc etc. J’ai testé le VBA ci dessous, l’émail se crée mais cela ne me mets pas automatiquement les adresses e-mails de la colonnes D et E, le destinataire reste vite et je dois ajouté à la main directement. Pourriez vous m’aider?

De plus je me demandais si on sera toujours obligé de cliquer envoyer sur cet e-mail ou si il est possible que cela envoie l’émail vraiment automatiquement sans aucune action nécessaire de notre part?

Private Sub Worksheet_Change(ByVal Target As Range)

'Updated by Extendoffice 2017/9/12

Dim xRgSel As Range

Dim xOutApp As Object

Dim xMailItem As Object

Dim xMailBody As String

On Error Resume Next

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Set xRg = Range("J:N")

Set xRgSel = Intersect(Target, xRg)

ActiveWorkbook.Save

If Not xRgSel Is Nothing Then

Set xOutApp = CreateObject("Outlook.Application")

Set xMailItem = xOutApp.CreateItem(0)

xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _

" in the worksheet '" & Me.Name & "' were modified on " & _

Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _

" by " & Environ$("username") & "."



With xMailItem

.To = Range("D:E")

.Subject = "Cell LPLV or Data transfer from TPL to LC or Data transfer from LC to client updated" & ThisWorkbook.FullName

.Body = xMailBody

.Attachments.Add (ThisWorkbook.FullName)

.Display

End With

Set xRgSel = Nothing

Set xOutApp = Nothing

Set xMailItem = Nothing

End If

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub


Merci d’avance pour votre aide,

Charline
 
Bonjour Chaton, et bienvenue sur XLD,
Tout d'abord, utilisez la balise </> pour le code c'est beaucoup plus lisible. ( à droite de l'icone GIF )
Je n'utilise pas Outlook, mais je pense que votre souci vient de la ligne :
VB:
.To = Range("D:E")
Range("D:E") désigne les deux colonnes D et E, et je ne crois pas qu'il comprenne.
Si vos adresses email sont par ex en D1 et E1 alors essayez :
Code:
Adresses = Range("D1") & ";" & Range("E1")
With xMailItem
    .To = Adresses
.....
Vous avez des ex en :
 
Bonjour,

Je suis entrain d’apprendre à me développer sur Excel et j’ai un problème pour le fichier de mon travail - voici la VBA ci dessous :

- Je souhaiterais envoyer un e-mail automatique lorsqu’une information est modifiée dans une des cellules des colonnes de J à M mais que cela envoie un e-mail uniquement aux deux adresses emails listées dans la colonne D et E.
Donc si par exemple il y a une modification en J1 cela devrait envoyer un e-mail à D1 et E1 etc etc. J’ai testé le VBA ci dessous, l’émail se crée mais cela ne me mets pas automatiquement les adresses e-mails de la colonnes D et E, le destinataire reste vite et je dois ajouté à la main directement. Pourriez vous m’aider?

De plus je me demandais si on sera toujours obligé de cliquer envoyer sur cet e-mail ou si il est possible que cela envoie l’émail vraiment automatiquement sans aucune action nécessaire de notre part?

Private Sub Worksheet_Change(ByVal Target As Range)

'Updated by Extendoffice 2017/9/12

Dim xRgSel As Range

Dim xOutApp As Object

Dim xMailItem As Object

Dim xMailBody As String

On Error Resume Next

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Set xRg = Range("J:N")

Set xRgSel = Intersect(Target, xRg)

ActiveWorkbook.Save

If Not xRgSel Is Nothing Then

Set xOutApp = CreateObject("Outlook.Application")

Set xMailItem = xOutApp.CreateItem(0)

xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _

" in the worksheet '" & Me.Name & "' were modified on " & _

Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _

" by " & Environ$("username") & "."



With xMailItem

.To = Range("D:E")

.Subject = "Cell LPLV or Data transfer from TPL to LC or Data transfer from LC to client updated" & ThisWorkbook.FullName

.Body = xMailBody

.Attachments.Add (ThisWorkbook.FullName)

.Display

End With

Set xRgSel = Nothing

Set xOutApp = Nothing

Set xMailItem = Nothing

End If

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub


Merci d’avance pour votre aide,

Charline
Bonjour Sylvanu,

Merci pour le retour, malheureusement ce n’est pas toujours D1 et E1 pour chaque ligne j’aurais des destinataires différents. J’ai essayé aussi : .To = Rangé («D&D ») & « ; » & Range (« E:E »)
Mais ça ne fonctionne pas non plus les adresses e-mails ne se mettent toujours pas dans les destinataires. Aurais-tu une idée?
 
Re,
Range("D.D") donne une plage, non des valeurs. Donc ça ne peut pas marcher.
Il vous faut construire la liste des destinataires. ( soit avec un for...next ou avec des "&".)
Pouvez vous fournir un fichier test ( anonyme et sans données sensibles ) ou encore un ex de vos colonnes D et E.
 
Re,
J'ai fait le fichier avec macro pour avoir les 2 noms
Le code pour l'envoi n'est pas mis
Bruno
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub ' si plusieurs selections
If Target.Value = "" Then Exit Sub ' si on efface
lig = Target.Row
If Application.Intersect(Target, Range("J:M")) Is Nothing Then Exit Sub
MsgBox Range("D" & lig) & "     " & Range("E" & lig)
If MsgBox("Voulez-vous envoyer les mails ?", vbExclamation + vbYesNo, "Outlook") = vbYes Then
'envoie mail
End If
'fait rien
End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
639
Réponses
2
Affichages
718
  • Question Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
387
Réponses
1
Affichages
854
Réponses
2
Affichages
512
Réponses
2
Affichages
923
Retour