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