Envoi mail à échéance sous condition avec lecture de plusieurs colonnes (taches)

**Toro74** · 02/03/2023, 14h23

Bonjour à tous,
J'ai un tableau avec plusieurs échéances relatives à des taches qui apparaissent sous forme de colonnes, avec pour chaque tache :
Intitulé de la tache (en en-tête)
Échéance
Message envoyé (Oui/Non)
En ligne les projets
Et en fin de tableau les mails des chefs de projet
Les taches sont récurrentes pour chacun des projets, ce qui explique cette organisation en tableau.
Je souhaite envoyer un mail au différents chef de projet avec l'intitulé du projet et la tache en question à une échéance de 30j.
J'ai réussi à le faire dans le cas d'une seule tache mais j'ai un nombre de tache conséquent, donc beaucoup de colonne.
Voici mon code actuel :

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
 
Sub EnvoiMail()
    Dim olApp As Object, M As Object, c As Range
    Set olApp = CreateObject("Outlook.application")
    With Sheets("Feuil1")
      For Each c In .Range("B3", .Cells(.Rows.Count, 1).End(xlUp))
        If IsDate(c.Value) Then
          If c > 0 And c.Offset(, 1) = "Non" Then
            If c - Date < 30 And c > Date Then
                              Set M = olApp.CreateItem(olMailItem)
              M.Subject = "Echéance " & Range("B1") & " " & c.Offset(, -1)
              M.Bcc = "Mailcopie@fr"
              M.body = "Bonjour," & vbCrLf & vbCrLf & "La " & Range("B1") & " du " & c.Offset(, -1) & _
                " arrive à échéance le " & c.Offset(, 0)
              M.Recipients.Add c.Offset(, 6)
              M.display
              c.Offset(, 1) = "Oui"
            End If
          End If
        End If
       Next c
    End With
End Sub

Une fois le mail envoyé la cellule message envoyé passe à oui.
Je suis bloqué pour le traitement des autres colonnes et je ne sais pas faire référence à l'intitulé de la tache.
Est-ce qu'il vous serait possible de me venir en aide?
Je vous joins le tableau en question, anonymisé.

Bonne journée.

Invité · 02/03/2023, 16h43

Bonjour Toro74

Essayez avec ce code

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
Const olMailItem As Long = 0
 
Sub EnvoiMail()
  Dim olApp As Object, M As Object, c As Range
  Dim dLig As Long, dCol As Long, Col As Long, Lig As Long
  Dim Cel As Range
  ' Créer une instance Outlook
  Set olApp = CreateObject("Outlook.application")
  With Sheets("Feuil1")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    dCol = .Cells(2, Columns.Count).End(xlToLeft).Column
    For Lig = 3 To dLig
      For Col = 2 To dCol - 1 Step 2
        ' Définir sur quelle cellule on travaille
        Set Cel = .Cells(Lig, Col)
        '
        If IsDate(Cel) And Cel.Offset(, 1) = "Non" Then
          If Cel - Date < 30 And Cel > Date Then
            Set M = olApp.CreateItem(olMailItem)
            M.Subject = "Echéance " & .Cells(1, Col) & " " & Cel.Offset(, -1)
            M.Bcc = "Mailcopie@fr"
            M.body = "Bonjour," & vbCrLf & vbCrLf & "La " & .Cells(1, Col) & " du " & Cel.Offset(, -1) & _
                     " arrive à échéance le " & Cel
            M.Recipients.Add .Cells(Lig, dCol)
            M.display
            Cel.Offset(, 1) = "Oui"
          End If
        End If
      Next Col
    Next Lig
  End With
End Sub

A+

**Toro74** · 02/03/2023, 18h15

Bonjour Bruno,
Je vous remercie d'avoir pris le temps de regarder ma demande, et ce, aussi rapidement

.
J'ai essayé avec le code et celui-ci ne produit pas d'effet. J'ai essayé de voir d'où vient le problème mais il n'y a pas de message d'erreur.
En faisant des essais et en supprimant le

Code :

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

To dCol - 2 Step 2

et en le remplaçant par 7, j'ai bien les mails qui sont créés, y compris pour la tache 3, mais la référence au projet n'est pas bonne pour les taches 2 et 3, cela renvoie oui, Cel.Offset(, -1) n'est visiblement plus valide car le projet n'est plus situé dans la cellule attenante.
Et forcement la référence au destinataire ne marche pas .
Cordialement.

**Toro74** · 03/03/2023, 11h33

Bonjour,
J'ai trouvé la solution en corrigeant le code ainsi :

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
 
 
Const olMailItem As Long = 0
 
Sub EnvoiMail()
  Dim olApp As Object, M As Object, c As Range
  Dim dLig As Long, dCol As Long, Col As Long, Lig As Long
  Dim Cel As Range
  ' Créer une instance Outlook
  Set olApp = CreateObject("Outlook.application")
  With Sheets("Feuil1")
 
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    dCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For Lig = 3 To dLig
      For Col = 2 To dCol - 2 Step 1
        ' Définir sur quelle cellule on travaille
        Set Cel = .Cells(Lig, Col)
        '
        If IsDate(Cel) And Cel.Offset(, 1) = "Non" Then
          If Cel - Date < 30 And Cel > Date Then
            Set M = olApp.CreateItem(olMailItem)
            M.Subject = "Echéance " & .Cells(1, Col) & " " & .Cells(Lig, 1)
            M.Bcc = "Mailcopie@fr"
            M.body = "Bonjour," & vbCrLf & vbCrLf & "La " & .Cells(1, Col) & " du " & .Cells(Lig, 1) & _
                     " arrive à échéance le " & Cel
            M.Recipients.Add .Cells(Lig, dCol)
            M.display
            Cel.Offset(, 1) = "Oui"
          End If
        End If
      Next Col
    Next Lig
  End With
End Sub