Discussion :

[daddygraffiti]

Bonjour,

Premier message sur le forum, débutant en VBA, l'indulgence est de mise

J'ai codé la macro suivante, or je ne comprends pas pourquoi mais elle ne s’exécute pas... C'est à dire que rien ne se passe.

Pourquoi ? De plus, si les HardCoderz du forum peuvent y apporter des corrections (si erreurs il y a) ou des améliorations, je suis preneur !

Merci et j'attends vos feedback

Comment ce code doit marcher ?
1) j'ouvre le fichier excel avec le modul VBA comportant le code
2) je chope un .xls (cf ci-joint) que j'ouvre
3) je lance le 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
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
 
Sub envoi_()
 
Dim libdufd As String, datedujour As Date, msgdumail As String
libdufd = Range("D3")
datedujour = FormatDateTime(today, vbShortDate)
msgdumail = "Fichier de collecte du fonds " & libdufd & " au " & datedujour
 
If Range("A3") = "XXXX" Then
 
Dim Message As String
    Message = "Attention mauvaise extract."
    Rep = MsgBox(Message, vbOK)
If Rep = vbOK Then Exit Sub
 
End If
 
If Left(libdufd, 3) = "MIR" Then
    Message = "Souhaitez-vous envoyer le fichier à xxxx@xxxx.com et yyyy@yyy.com ?"
    Rep = MsgBox(Message, vbYesNo)
 
If Rep = vbNo Then Exit Sub
    Else
If Rep = vbYes Then
 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error Resume Next
With OutMail
    .To = "xxxx@xxx.com; yyyy@yyyy.com"
    .CC = "zzzz@zzzz.com"
    .Subject = "fichier de " & libdufd
    .Body = msgdumail
    .Attachments.Add ActiveWorkbook.FullName
    .Send
End With
On Error GoTo 0
 
Set OutMail = Nothing
Set OutApp = Nothing
 
    Message = "Souhaitez-vous envoyer le fichier à zzzz@zzzz.com ?"
    Rep = MsgBox(Message, vbYesNo)
 
If Rep = vbNo Then Exit Sub
    Else
If Rep = vbYes Then
 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error Resume Next
With OutMail
    .To = "zzzz@zzzz.com"
    .CC = ""
    .Subject = "fichier de " & libdufd
    .Body = msgdumail
    .Attachments.Add ActiveWorkbook.FullName
    .Send
End With
On Error GoTo 0
 
Set OutMail = Nothing
Set OutApp = Nothing
 
End If
    End If
        End If
End Sub