Macro ne s'execute pas

Version imprimable

1 pièce(s) jointe(s)

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:

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

Today n'existe pas... il faut utiliser Date

Code:

1
2
3
If Rep = vbNo Then Exit Sub
    Else
If Rep = vbYes Then

Ici, ça ne sert à rien de mettre la partie Else
Si ce n'est pas No, c'est donc Yes (avec vbYesNo)

Voici le code un peu modifié qui devrait fonctionner

Code:

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
Sub envoi_()
 
    Dim libdufd As String, datedujour As Date, msgdumail As String
    libdufd = Range("D3")
    datedujour = FormatDateTime(Date, 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
 
    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
    .display
    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
 
 
    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
    .display
    End With
    On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing
 
    End If
End Sub

07/08/2013, 19h41
daddygraffiti

Bonjour parmi,

Merci pour ta réponse car maintenant la macro s’exécute.

Par contre, pourquoi est-ce qu'avant tes modifs, elle ne s’exécutait pas ?

Bonne soirée !

Il y avait un peu de mélange entre les If... Else... End If...

Quand tu écris
Code:

1 2 3 4 5 6 7 8 9 10 ......... 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 .........
Avec quel If va le Else ?

Comme tu écris If Rep = vbNo Then Exit Sub sur une seule ligne, le Else se retrouve avec If Left(....)

Si tu avais écrit
Code:

1 2 3 If Rep = vbNo Then Exit Sub Else
Le Else aurait été "attaché" au If Rep...

En passant ton code en pas à pas (F8), tu pourrais voir comment il réagit selon les réponses aux messages...

12/08/2013, 21h16
daddygraffiti

Bonsoir Parmi,

Merci pour tes explications, elles m'ont bien aidé !

cheers !