Microsoft 365 VBA Création Question liste destinataire

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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 :
 

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

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

youky(BJ)

XLDnaute Barbatruc
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

  • ChatonXLD.xlsm
    14.7 KB · Affichages: 1

Discussions similaires

Réponses
2
Affichages
236
Réponses
2
Affichages
114

Statistiques des forums

Discussions
312 207
Messages
2 086 231
Membres
103 161
dernier inscrit
Rogombe bryan