Bug sur Envoi de mail Outlook à partir d'une macro

**graphikris** · 24/03/2013, 20h11

Re et merci mais bugue ici

Code :

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

1
2
'----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
For I = 1 To 150

sur I

Variable non définie

_________
Cordialement

**Daniel.C** · 24/03/2013, 21h58

Eh bien, définis-la :

Code :

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

Dim I as Integer

ou ne laisse pas des instructions que tu ne comprends pas. Personnellement, j'ai mis en commentaire :

Code :

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

'Option Explicit

ce que je fais toujours quand je mets au point un code.

**graphikris** · 25/03/2013, 18h39

Merci Daniel pour ta réponse.
Je teste dès que possible et te dis au courant.

Je savais qu'il fallait mettre Dim I as mais as QUOI, je ne connais que String (pour une chaine de caracteres, je suppose) mais ne connais pas le reste des instructions et à quoi elle serve.

Cordialement,
Graphikris

**Daniel.C** · 25/03/2013, 18h53

Si tu ne sais pas, tu peux toujours mettre :

Code :

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

Dim I

ou

Code :

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

Dim I as Variant

sans plus de précision.

**graphikris** · 25/03/2013, 19h26

Bonsoir Daniel,

Un nouveau souci. Voici donc le code (re)modifié avec suppression des codes en commentaires qui sont inutiles.

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
Sub Envoi_Mail()
Dim olapp As Outlook.Application
Dim malist, Count, Envoi, AdresseRépertoire As Variant
 'On Error Resume Next
            '-------Contrôler dans Visual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
 
 
Dim Sujet As String
Dim Corps As String
 
' Effacement des doonées sur feuille Matrice Mail
 
Sheets("Matrice Mail").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
 
 
    'Boucle
 Do
    'Boite de dialogue demandant le sujet du mail
    Sujet = InputBox("Veuillez saisir le sujet de votre @mail :" & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Sujet")
    'si sujet non saisi alors retour jusqu a saisi
    If Sujet = "" Then
MsgBox "Vous n'avez pas saisi de sujet." _
 & "La zone est obligatoire", vbExclamation
 End If
 Loop Until Sujet <> ""  'Fin de boucle
 
 
 'Boucle
 Do
 'Boite de dialogue demandant le corps du message
    Corps = InputBox("Veuillez saisir le corps de votre message : " & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Corps")
  'si Corps non saisi alors retour jusqu a saisi
  If Corps = "" Then
 MsgBox "Vous n'avez pas saisi de texte pour le corps de votre message." _
 & "La zone est obligatoire", vbExclamation
 End If
Loop Until Corps <> ""  ' Fin de boucle
 
 
 
Dim I As Integer
Dim adresse(1 To 150)
            '----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 151
Set malist = Sheets("Envoi Mail").Range("A2:A151")
Count = 1
For Each Envoi In malist
If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1
Next
            '----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
For I = 1 To 150
    If adresse(I) = "" Then Exit For
    If adresse(I) Like "*@*" Then [H1] = [H1] & ";" & adresse(I)
Next I            '-------adresse du répertoire ou sera enregistré le fichier
AdresseRépertoire = ActiveWorkbook.Path
            '---------------------copie de la feuille à envoyer
Application.DisplayAlerts = False
Sheets("Matrice Mail").Copy
            '---------------------Nom du fichier à envoyer
Dim NameXls As String
 
 Do
    'Boite de dialogue demandant le Nom du fichier à envoyer
    NameXls = InputBox("Veuillez saisir le nom du fichier à envoyer :" & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Nom du fichier à envoyer")
    'si NameXls non saisi alors retour jusqu a saisi
    If NameXls = "" Then
MsgBox "Vous n'avez pas saisi de nom pour le fichier à envoyer." _
 & "La zone est obligatoire", vbExclamation
 End If
 Loop Until NameXls <> ""
 
 
ActiveWorkbook.SaveAs AdresseRépertoire & "\" & NameXls & ".xls"
ActiveWindow.Close
            '---------------------Envoi par mail
Sheets("Envoi Mail").Select
Range("H1").Select
            '---------------------contrôle la validité ou la présence d'adresse mail en H1
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = Range("H1").Value 'Adresse de la cellule contenant la liste des adesses mails
            '--------------------Saisir le sujet de l'envoi
msg.Subject = Sujet  'Sujet étant la InputBox
            '---------------------saisie du message
            '-------------------- saisir le message dans InputBox Corps
 msg.Body = Corps
            '---------------------Adresse de la pièce jointe
msg.Attachments.Add Source:=AdresseRépertoire & "\" & NameXls & ".xls"
msg.Send
            '---------------------effacement de la liste d'envoi
[H1].ClearContents
Application.ScreenUpdating = True
 
[A2:A151].ClearContents
Range("A1").Select
 
Sheets("Requete").Select
Range("A1").Select

 
End Sub

çà ne veux pas envoyer le mail car bugue sur la ligne 93 msg.Send
car au lieu de copier les adresses des destinataires en H1 de la feuille "Envoi Mail", çà vient se mettre en H1 de la feuille "Matrice Mail" donc vu qu'excel ne trouve rien en H1 Envoi Mail, j'ai une erreur me disant que impossible d'envoyer car par de destinataires en à, CCi , ....

Et comment faire pour que le fichier joint transmis aille de coller dans un répertoire précis au lieu de se mettre sur le bureau ?

Cordialement,
Graphikris

Ok pour l'explication du Dim mais pour le pb du H1 dans la mauvaise feuille voir comm précédent

Merci Daniel pour ton aide

**Daniel.C** · 25/03/2013, 21h04

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
Sub Envoi_Mail()
Dim olapp As Outlook.Application
Dim malist, Count, Envoi, AdresseRépertoire As Variant
 'On Error Resume Next
            '-------Contrôler dans Visual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
 
Dim Sujet As String
Dim Corps As String
 
' Effacement des doonées sur feuille Matrice Mail
 
With Sheets("Envoi Mail")
    Sheets("Matrice Mail").Select
        Cells.Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
        Range("A1").Select
 
 
        'Boucle
     Do
        'Boite de dialogue demandant le sujet du mail
        Sujet = InputBox("Veuillez saisir le sujet de votre @mail :" & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Sujet")
        'si sujet non saisi alors retour jusqu a saisi
        If Sujet = "" Then
    MsgBox "Vous n'avez pas saisi de sujet." _
     & "La zone est obligatoire", vbExclamation
     End If
     Loop Until Sujet <> ""  'Fin de boucle
 
 
     'Boucle
     Do
     'Boite de dialogue demandant le corps du message
        Corps = InputBox("Veuillez saisir le corps de votre message : " & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Corps")
      'si Corps non saisi alors retour jusqu a saisi
      If Corps = "" Then
     MsgBox "Vous n'avez pas saisi de texte pour le corps de votre message." _
     & "La zone est obligatoire", vbExclamation
     End If
    Loop Until Corps <> ""  ' Fin de boucle
 
 
 
    Dim adresse(1 To 150)
                '----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 151
    Set malist = Sheets("Envoi Mail").Range("A2:A151")
    Count = 1
    For Each Envoi In malist
    If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1
    Next
                '----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
    For i = 1 To 150
        If adresse(i) = "" Then Exit For
        If adresse(i) Like "*@*" Then .[H1] = .[H1] & ";" & adresse(i)
    Next i            '-------adresse du répertoire ou sera enregistré le fichier
    AdresseRépertoire = ActiveWorkbook.Path
                '---------------------copie de la feuille à envoyer
    Application.DisplayAlerts = False
    Sheets("Matrice Mail").Copy
                '---------------------Nom du fichier à envoyer
    Dim NameXls As String
 
     Do
        'Boite de dialogue demandant le Nom du fichier à envoyer
        NameXls = InputBox("Veuillez saisir le nom du fichier à envoyer :" & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Nom du fichier à envoyer")
        'si NameXls non saisi alors retour jusqu a saisi
        If NameXls = "" Then
    MsgBox "Vous n'avez pas saisi de nom pour le fichier à envoyer." _
     & "La zone est obligatoire", vbExclamation
     End If
     Loop Until NameXls <> ""
 
 
    ActiveWorkbook.SaveAs AdresseRépertoire & "\" & NameXls & ".xls"
    ActiveWindow.Close
                '---------------------Envoi par mail
    Sheets("Envoi Mail").Select
    .Range("H1").Select
                '---------------------contrôle la validité ou la présence d'adresse mail en H1
    Dim msg As MailItem
    Set olapp = New Outlook.Application
    Set msg = olapp.CreateItem(olMailItem)
    msg.To = .Range("H1").Value 'Adresse de la cellule contenant la liste des adesses mails
                '--------------------Saisir le sujet de l'envoi
    msg.Subject = Sujet  'Sujet étant la InputBox
                '---------------------saisie du message
                '---------------------ou saisir le message dans des cellules
                '---------------------ou saisir le message dans InputBox Corps
     msg.Body = Corps
                '---------------------Adresse de la pièce jointe
    msg.Attachments.Add Source:=AdresseRépertoire & "\" & NameXls & ".xls"
    msg.Display
    msg.Send
                '---------------------effacement de la liste d'envoi
    [H1].ClearContents
    Application.ScreenUpdating = True
 
    [A2:A151].ClearContents
    Range("A1").Select
 
    Sheets("Requete").Select
    Range("A1").Select
End With
End Sub

Si tu veux spécifier un dossier particulier pour les fichiers joints :

mets cette ligne au début de ta macro :

AdresseRépertoire = "C:\Temp"

ou ce que tu veux.

**graphikris** · 26/03/2013, 19h56

Bonjour Daniel,

Merci pour la modification du code, maintenant çà fonctionne.

Petit bémol pour le chemin vers lequel le fichier joint doit aller se copier, j'ai bien mis en début de code :

Code :

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

AdresseRépertoire = "C:\Temp"

afin que le fichier aille se copier sur C dans le repertoire temporaire mais bug, je remet donc le code afin de te dire le nmr de ligne du bug et un petit truc qui me chagrine.

Code :

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

1
2
3
4
Sub Envoi_Mail()
Dim olapp As Outlook.Application
Dim malist, Count, Envoi, AdresseRépertoire As Variant
 'On Error Resume Next

Ligne3 il y a dejà AdresseRépertoire As Variant et si je supprime AdresseRépertoire As Variant => REFUS et si je supprime juste AdresseRépertoire et que je laisse As Variant => REFUS

Sinon à la ligne 57 j'ai :

Code :

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

AdresseRépertoire = ActiveWorkbook.Path

que je le supprime ou non çà bugue toujours.

Cordialement,
______Graphikris

**Daniel.C** · 27/03/2013, 20h42

Bonsoir,

J'avais lu :

Merci pour la modification du code, maintenant çà fonctionne.

et je n'ai pas lu le reste. Je ne vois pas où est ton erreur quand tu exécutes ma macro. Peux-tu me dire la ligne et le message de l'erreur ?

**graphikris** · 27/03/2013, 21h02

Le msg est le suivant : erreur de compilation
Déclaration existante dans la portée en cours

et bugue ici

Code :

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

Dim malist, Count, Envoi, AdresseRépertoire As Variant

sur AdresseRépertoire As Variant

**Daniel.C** · 27/03/2013, 22h53

Ca veut dire que tu as déclaré deux fois la variable "AdresseRépertoire". Remplace la ligne par celle-ci :

Code :

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

Dim malist, Count, Envoi

**graphikris** · 28/03/2013, 19h51

Bonsoir Daniel,

Tout est rentré dans l'ordre.
Désormais le code est parfait.
Ce Week end, j'en profiterais pour le partager dans la rubrique "Contribuez" avec un tuto adapté.

Encore Merci pour ton aide. Sans toi j'aurais galéré des jours et des jours et n'aurais certainement pas pu arrivé à faire ce que je voulais.

Je te citerais en exemple dans le tuto

@+ daniel,

___________
Cordialement, Graphikris qui a enrichi son vocabulaire Vba grace à ton aide.

Bug sur Envoi de mail Outlook à partir d'une macro [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager