Envoi de mails multiples - pièce jointe différente

Version imprimable

05/06/2014, 11h32
Niconewrest

Envoi de mails multiples - pièce jointe différente

J'ai lu cette discussion.

Bonjour Dominique,

Je reviens vers toi concernant ce code crée en 2011....
je t'avoue que pour moi la VBA c'est un peu la 4eme dimension...

Comment incorporer ces 2 lignes de variables au code ci dessus?

merci de ton aide

Bonjour,

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
Sub Test()
Mail "Sujet ", "Message", "Destinataire@gmail.com", "DestinataireCopy@gmail.com", "DestinataireCopyCacher@gmail.com", "C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm"
 
Mail "Sujet ", "Message", "Destinataire@gmail.com", Pj:="C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm"
End Sub
 
Sub Mail(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set objOutlook = CreateObject("Outlook.application")
Set MailObj = objOutlook.CreateItem(olMailItem)
With MailObj
    .To = Destinataire
    .CC = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Message
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .Send
End With
 
End Sub

05/06/2014, 12h07
Niconewrest

Merci robert,
mais ce code n'a plus rien a voir avec celui d'origine...

tu as raison il est mieux que l'origine il marche partout!
la fonction Mail est utilisable sur n'import quelle vba.
en plus il est simple à utiliser.

Code:

1
2
3
4
5
Mail "Sujet", "Message", "Destinataire@gmail.com", Pj:="C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", Pj:="C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm", DestinataireCopy:="DestinataireCopy.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", DestinataireCopy:="DestinataireCopy.com", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com",DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com"

en plus il fonctionne en HTML et il permet de multiplier les pièces jointent

voici le même 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
Sub envoi()
Dim cel As Range, fc As String, admail As String
Dim responsable As String, messmail As String
responsable = "Toto"
'ci-dessous une feuille "adresses"
For Each cel In Sheets("adresses").Range("A2:a33") 'si les données (adresses mail et fichier à envoyer) sont en A et B
   admail = cel.Value
   fc = cel(1, 2).Value 'attention mettre chemin complet du fichier à envoyer
   messmail = "Bonjour" & Chr(10) & "Ci-joint, le fichier" & Chr(10) & Chr(10) & responsable
   'ci-dessous vérifier le chemin d'outlook
 If Trim("" & admail) <> "" Then Mail "CHALETS A JOUR", messmail, admail, Pj:=fc
Next cel
End Sub
 
 
Sub Mail(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set objOutlook = CreateObject("Outlook.application")
Set MailObj = objOutlook.CreateItem(olMailItem)
With MailObj
    .To = Destinataire
    .CC = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Replace(Messagec, Chr(10), "<br>")
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .Send
End With
 
End Sub

05/06/2014, 12h56
Niconewrest

Ok
donc si je veux qu'il parte d'un tableur xl,
quelle est le code pour :
colonne A : adresse mail,
colonne B : chemin du fichier

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
Sub test()
Dim R As Range
Dim L As Long
Set R = ActiveSheet.UsedRange
For L = 2 To R.Rows.Count'si la première linge est le titre
'si non For L = 1 To R.Rows.Count
If Trim("" & R(L, 1)) <> "" Then Mail "Etat des stocks", "Vous trouverez en pièce joint le fichier de compte rendu des provisions de sucettes !", R(L, 1), Pj:=R(L, 2)
Next
End Sub
 
 
Sub Mail(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set objOutlook = CreateObject("Outlook.application")
Set MailObj = objOutlook.CreateItem(olMailItem)
With MailObj
    .To = Destinataire
    .CC = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Replace(Messagec, Chr(10), "<br>")
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .Send
End With
 
End Sub

05/06/2014, 14h14
Niconewrest

Jai le message d'erreur suivant :

Erreur d'exécution '-2147024894 (80070002)':
Fichier introuvable. Vérifier que le chemin d'accès et le nom du Fichier sont corrects.

J'ai vérifier, tout est bon.

En voulant deboguer, je tombe sur .Attachments.Add Trim("" & p(i))
05/06/2014, 14h26
Invité

ajoutes ce code e regarde la fenêtre d'exécution touche [ctrl] + [G]

Code:

debug.print Trim("" & p(i))
05/06/2014, 14h47
Niconewrest

Le mail est envoyé, super,

mais la pièce jointe ne l'ai pas
05/06/2014, 14h57
Invité

tu as testé

Code:

Debug.Print Trim("" & p(i))

?
05/06/2014, 15h04
Niconewrest

oui, je l'ai mis a la place de :

Code:

Then .Attachments.Add Trim("" & p(i))

donc une erreur

sur quelle ligne de code dois je le mettre?

Code:

1
2
3
4
For i = 0 To UBound(p)
        Debug.Print Trim("" & p(i))
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next

05/06/2014, 15h20
Niconewrest

J'ai le même message d'erreur que tout à l'heure

Erreur d'exécution '-2147024894 (80070002)':
Fichier introuvable. Vérifier que le chemin d'accès et le nom du Fichier sont corrects.
05/06/2014, 15h23
Invité

il faut que tu regarde dans la fenêtre de débugage le résultat pour lactivé il faut appuyer simultanément sur les touches [CTRL] + [G]
05/06/2014, 15h25
Niconewrest

merci de ta patience.
je regarde
05/06/2014, 15h37
Invité

je viens de me configurer une boîte gmail et Outlook que je n'utilise jamais, et ça marche j'ai même mis 3 pièces jointes!
05/06/2014, 16h18
Niconewrest

J'ai compris,
je n'avais pas mis l'extension .xlsx

comme un débutant en VBA....

Merci beaucoup de ton aide et de ta patience
06/06/2014, 16h52
Niconewrest

Bonjour Rober,
Tout fonctionne,
seulement le corps du mail est vide malgré

merci de ton aide

comment renseigne tu les variable sujet et message?

Code:

1
2
3
sujet="Etat des stocks"
message="Vous trouverez en pièce joint le fichier de compte rendu des provisions de sucettes !"
Mail  sujet,message , R(L, 1), Pj:=R(L, 2)