Macro pour envoi de mail auto selon conditions

**soadadrinker** · 11/06/2013, 00h16

Bonjour,

Je souhaite développer un outil pour suivre une série de problème d'utilisation d'un autre outil.

En fait, j'aimerais que les personnes qui rencontrent des problèmes les inscrivent dans une cellule et une fois qu'ils sauvegardent, qu'un mail soit automatiquement envoyé à une tierce personne pour le traiter.
Puis, selon le statut du problème, que ca suive la même logique pour avertir telle ou telle personne dont le mail est renseigné.

J'ai commencé à travailler sur l'idée mais tout ne fonctionne pas complètement (voir fichier joint)

Je vous joint également le code ci-dessous (je n'arrive pas à attacher le fichier avec le code inclus directement)

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
   Dim OlApp As Outlook.Application
    Dim OlItem As Outlook.MailItem
 
    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
 
 
For i = 3 To 6
Set OlItem = OlApp.CreateItem(olMailItem)
 
     With OlItem
 
destended = Sheets("Sheet1").Cells(i, 5)
desttostart = "contact@exemple.com"
destforwarded = Sheets("Sheet1").Cells(i, 11)
issue = Sheets("Sheet1").Cells(i, 4)
Priority = Sheets("Sheet1").Cells(i, 2)
Date = Sheets("Sheet1").Cells(i, 1)
estimation = Sheets("Sheet1").Cells(i, 12)
 
 
If Sheets("Sheet1").Cells(i, 5) <> "" & Sheets("Sheet1").Cells(i, 7) = "" Then
 
        .To = desttostart
        .Subject = "Erreur " & Date & "" & Priority & " Ligne " & i&
        .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
             & "Bonjour,<p>" _
    & "Merci de consulter le fichier.<br>" _
    & "Nouveau problème concernant:<font color='blue'>" & issue & "</font> from " & destended & "<br>" _
    & " <p>" _
    & "Merci. <p>" _
    & "Bonne journée. <p>" _
    & "</body><HTML>"
        .Send
        End If
 
 If Sheets("Sheet1").Cells(i, 5) <> "" & Sheets("Sheet1").Cells(i, 7) = "Transmis" & Sheets("Sheet1").Cells(i, 10) = "" Then Sheets("Sheet1").Cells(i, 10) = "Y" & _
        .To = destforwarded
        .Subject = "Erreur " & Date & "" & Priority & " Ligne " & i&
        .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
             & "Bonjour,<p>" _
    & "Merci de consulter le fichier.<br>" _
    & "Nouveau problème concernant:<font color='blue'>" & issue & "</font> from " & destended & " < br > " _
    & " <p>" _
    & "Merci. <p>" _
    & "Bonne journée. <p>" _
    & "</body><HTML>"
        .Send
    End If
 
 
     If Sheets("Sheet1").Cells(i, 5) <> "" & Sheets("Sheet1").Cells(i, 7) = "Commencé" & Sheets("Sheet1").Cells(i, 9) = "" Then Sheets("Sheet1").Cells(i, 9) = "Y" & _
        .To = destended
        .Subject = "Problème du " & Date & "" & Priority & " Ligne " & i&
        .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
             & "Bonjour,<p>" _
    & "Le problème concernant <font color='blue'>" & issue & "</font> a  été <b>commencé</b>.< br > " _
    & " <p>" _
    & "Date estimative de résolution: " & estimation & ". <p>" _
    & "Merci. <p>" _
    & "Bonne journée. <p>" _
    & "</body><HTML>"
        .Send
    End If
 
    If Sheets("Sheet1").Cells(i, 5) <> "" & Sheets("Sheet1").Cells(i, 7) = "Terminé" & Sheets("Sheet1").Cells(i, 8) = "Y" & Sheets("Sheet1").Cells(i, 11) = "" Then Sheets("Sheet1").Cells(i, 11) = "Y" & _
 
        .To = destended
        .Subject = "Problème du " & Date & "" & Priority & " ligne " & i&
        .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
             & "Bonjour,<p>" _
    & "Le problème concernant <font color='blue'>" & issue & "</font> a été <font color='red'>résolu</font>.<br>" _
    & "Vous pouvez consulter le fichier pour les commentaires.<br>" _
    & " <p>" _
    & "Merci. <p>" _
    & "Bonne journée. <p>" _
    & "</body><HTML>"
        .Send
    End If
 
 
    If Sheets("Sheet1").Cells(i, 5) <> "" & Sheets("Sheet1").Cells(i, 7) = "Terminé" & Sheets("Sheet1").Cells(i, 8) = "N" & Sheets("Sheet1").Cells(i, 11) = "" Then Sheets("Sheet1").Cells(i, 11) = "Y" & _
 
        .To = destended
        .Subject = "Problème du " & Date & "" & Priority & " ligne " & i&
        .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
             & "Bonjour,<p>" _
    & "Le problème concernant <font color='blue'>" & issue & "</font> a été <font color='red'>traité mais n'est pas résolu</font>.<br>" _
    & "Vous pouvez consulter le fichier pour les commentaires.<br>" _
    & " <p>" _
    & "Merci. <p>" _
    & "Bonne journée. <p>" _
    & "</body><HTML>"
        .Send
    End If
 
    End With
Next i
 
 
End Sub

Est-ce que quelqu'un aurait une idée pour un développement sur excel 2007 (de préférence)?
Je ne suis pas un grand expert alors n'hésitez pas à mettre des notes dans le code pour que je puisse faire des retouches pour l'adapter dans le cas où je devrais y apporter des modifications par la suite.

Merci beaucoup.

Macro pour envoi de mail auto selon conditions

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager