Envoyer un email en fonction de la valeur de la cellule

Bonjour,

Dans le cadre d'un projet dans mon entreprise, je souhaiterais envoyer un email automatiquement (par outlook) en fonction de la valeur d'une cellule.

L'idée serait que lorsque nous avons une modification, celle-ci soit envoyée directement aux commerciaux responsables du secteur, pour une validation.

Ci-joint un fichier, dans l'onglet "Listing" un ensemble de magasins qui sera rentré par notre administration. Dans la colonne D "ligne" une recherche V en fonction du numéro de département. Le but serait que l’administration rentre les lignes A B et C puis que l'envoi se fasse aux destinataires en fonction de la ligne.

Par exemple pour "Paris Express" l'envoi doit être effectué à 75@a.fr 75@b.fr 75@c.fr 75@d.fr

J'ai trouvé un code sur internet qui marche bien, hors j'aimerais modifier la fonction Target.Value en fonction de cette ligne pour rapatrier les destinataires du mail.

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Est-ce possible ?

Merci

Bonjour,

à tester,

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 Then

            For col = 3 To 6
            ligne = Sheets("Listings").Cells(Target.Row, "D")
                sTO = Sheets("Liste vendeur").Cells(ligne, col)
                Call Mail_small_Text_Outlook(sTO)
            Next i
    End If
End Sub

Sub Mail_small_Text_Outlook(sTO)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = sTO
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Merci de ta réponse

Malheureusement cela ne marche pas, est-ce possible d'incrémenter le champs d'une cellule dans un code VBA ?

Par exemple pour les destinataires (email) je pourrais mettre une colonne masqué et le code irait chercher par exemple dans la cellule B5

J'ai essayé de changer ma logique par rapport à hier, je pense que ça sera plus simple.

Colonne B : Nous avons des cellules de validation qui permet aux vendeurs de valider la ligne

Colonne F : La personne qui doit valider

Avec le code actuellement en place, lorsque nous avons une modification en colonne B un mail est automatiquement généré. J'aimerais que le nom du destinataire correspondant à la ligne soit inséré automatiquement.

Par exemple quand la case de validation (B3) est cochée, cela insére automatiquement les valeurs de F3 et G3

B4 = F4 = G4 etc etc...

Merci de votre aide

Trouvé

.To = Cells(Target.Row, 6).Value