VBA Mail personnalisé

Bonjour à tous, je dois me confronter à un OS. Je dois envoyé un mail (au même destinataire) par rapport aux infos de chaque ligne à chaque fois que je mets le statut en "planifié". J'ai codé le VBA (j'ai galéré) qui se trouve ci-dessous. Le problème est que quoi que je fasse c'est la ligne 7 qui est en permanence prise en compte. Pouvez-vous m'aider svp ? Où ce trouve mon erreur ?

Merci pour vos réponses.

Dim xRg As Range
'Update by Extendoffice 2020/6/12
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("A:A"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Planifié" 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
Dim ligne As Integer
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
For ligne = 7 To 15
xMailBody = "Bonjour, veuillez prendre connaissance de l'entrée de ce véhicule" & vbNewLine & vbNewLine & _
Range("C" & ligne) & vbNewLine & _
"Concerne le véhicule de" & " " & Range("D" & ligne)

On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Immat" & Range("F" & ligne) & " " & Range("E" & ligne)
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
Next ligne
End Sub

capture d ecran forum

Salut,

Je ne sais pas si c'est la bonne méthode...
En effet à chaque modification tu testes si les lignes sont marquées "Validées" dans ce cas de figure tu va te retrouver avec des courriels envoyés plusieurs fois. Donc à mon avis tu dois ajouter une colonne qui dis que le courriel à été envoyé.

il vaut mieux pour toi d'une part travailler avec un tableau structuré et d'autre part déclencher toi même l'envoie des courriels avec un bouton.
tu pourrait par exemple mettre un code de ce type dans l'évènement de ton bouton. que je n'est pas testé d'ailleurs.

Dim Ele
Dim t As ListObject
    Set t = Range("NomDuTableau").ListObject ' // Donner le nom du tableau

    For Each Ele In t.ListColumns("Status dossier").DataBodyRange
        With Ele
            If .Value = "Planifié" And t.liscolumns("Courriel").DataBodyRange(.Row).Value <> "Envoyé" Then

                ' // ICI ON LANCE L'ENVOIE DU COURRIER
                ' // construire un fonction d'envoie qui retourne -1 si tout c'est bien déroulé

                Select Case EnvoieCourriel(t.ListRows(.Row).Range) ' // si tu envoie la ligne de ton tableau tu peux récupérer les infos pour l'envoie du courriel
                    Case -1
                        ' // si tout est OK on pointe comme quoi le courriel est parti
                        t.ListColumns("Courriel").DataBodyRange(.Row).Value = "Envoyé"
                    Case Else
                        MsgBox "Un problème est survenu dans l'envoie du courrier de " & t.ListColumns("Nom Client").DataBodyRange(.Row).Value
                End Select
            End If
        End With
    Next

et ta fonction d'envoie

Function EnvoieCourriel(lstRow As ListRow)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String

    On Error GoTo EnvoieCourriel_Error

    xMailBody = "Bonjour, veuillez prendre connaissance de l'entrée de ce véhicule" & vbNewLine & vbNewLine & _
                lstRow.Range.Columns("TEC") & vbNewLine & _
                "Concerne le véhicule de " & lstRow.Range.Columns("Type Véh.")

    With xOutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Immat" & lstRow.Range.Columns("Immatriculation") & " " & lstRow.Range.Columns("Type Véh.")
        .Body = xMailBody
        .Display                            ' // .Send pour envoyer sans ouvrir le courriel
    End With

    EnvoieCourriel = -1                     ' // Si tout va bien

EnvoieCourriel_Exit:
    ' // Il vaut mieux tester avant de définir sur Nothing  cela t'évitera d'autres messages d'erreur
    If Not xOutMail Is Nothing Then Set xOutMail = Nothing
    If Not xOutApp Is Nothing Then Set xOutApp = Nothing

    Exit Function

EnvoieCourriel_Error:

    EnvoieCourriel = Err.Number             ' // & ";" & Err.Description ' // Si problème on renvoie le numéro de l'erreur

    Resume EnvoieCourriel_Exit
End Function

Bonjour, merci pour votre réponse. Malheureusement, je n'arrive pas à faire fonctionner la VBA. Il y a déjà une macro qui empêche de mettre sous forme de tableau. J'ai essayé également d'adapter la VBA au fait que je n'ai pas de tableau, mais celle-ci ne se lance pas lors que je mets sur "planifié".

Rechercher des sujets similaires à "vba mail personnalise"