Discussion :

[Niconewrest]

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

[Invité]

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
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

[Niconewrest]

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

[Invité]

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 :

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

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 :

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
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

[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

[Invité]

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
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

[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))

[Invité]

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

Code :

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

debug.print  Trim("" & p(i))

[Niconewrest]

Le mail est envoyé, super,

mais la pièce jointe ne l'ai pas

[Invité]

tu as testé

Code :

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

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

?

[Niconewrest]

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

Code :

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

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

donc une erreur

sur quelle ligne de code dois je le mettre?

[Invité]

Code :

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

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

[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.

[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]

[Niconewrest]

merci de ta patience.
je regarde

[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!

[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

[Niconewrest]

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

merci de ton aide

[Invité]

comment renseigne tu les variable sujet et message?

Code :

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

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)