Discussion :

[RicardoBxl]

Bonjour les Amis,

Cela fait longtemps que je ne suis pas venu ici. Mais bon me revoilà.

J'espère que vous allez tous bien en tout cas

Voilà mon souci:

J'ai une procédure pour créer un mail dans laquelle à un moment donné j'utilise l'instruction Select pour que les destinataires du mail soient sélectionnés mais ca ne marche pas. Pourtant dans mon bouquin VBA ils proposent l'utilisation de Select.

Dans l'onglet Recipients j'ai la liste des destinataires de mon email.

Quelqu'un peut me dire pourquoi cela ne marche pas ?

Merci d'avance,

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
Private Sub BTN_Emails_Click()
 
Dim My_Outlook As New Outlook.Application
Dim My_Message As Outlook.MailItem
Dim List_Recipients As Worksheet
 
On Error Resume Next
 
Set List_Recipients = ThisWorkbook.Worksheets("Recipients")
 
Set My_Message = My_Outlook.CreateItem(olMailItem)
 
With My_Message
    .Subject = "Approval payment order - Expat TE"
    .Body = "Chère Véronique, je te prie de trouver ci-après un ordre de paiement à approuver." _
        & vbCrLf & "Cordialement." & vbCrLf & vbCrLf & "Arrabito Ricardo"
    .BodyFormat = olFormatHTML
 
 
 
 
    List_Recipients.Range("A1").Select
 
    Do While ActiveCell <> ""
 
        .Recipients.Add (ActiveCell.Value)
        ActiveCell.Offset(1, 0).Select
    Loop
 
    .Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
    .Send
 
End With
 
'My_Outlook.Quit
 
Set My_Outlook = Nothing
Set My_Message = Nothing
Set List_Recipients = Nothing
 
End Sub

[casefayere]

Bonjour,
essayes comme ça (fait sans tester, bien sur)

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
Private Sub BTN_Emails_Click()
 
Dim My_Outlook As New Outlook.Application
Dim My_Message As Outlook.MailItem
Dim List_Recipients As Worksheet
Dim cel As Range, plg As Range, derlg As Long
 
On Error Resume Next
 
Set List_Recipients = ThisWorkbook.Worksheets("Recipients")
With List_Recipients
  derlg = .Range("A" & .Rows.Count).End(xlUp).Row
  Set plg = .Range("A1:A" & derlg)
End With 
Set My_Message = My_Outlook.CreateItem(olMailItem)
 
With My_Message
    .Subject = "Approval payment order - Expat TE"
    .Body = "Chère Véronique, je te prie de trouver ci-après un ordre de paiement à approuver." _
        & vbCrLf & "Cordialement." & vbCrLf & vbCrLf & "Arrabito Ricardo"
    .BodyFormat = olFormatHTML
 
    For Each cel In plg
      .Recipients.Add cel.Value
    Next cel
    'ou
    '.recipients.list = plg
 
    .Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
    .Send
 
End With
 
'My_Outlook.Quit
 
Set My_Outlook = Nothing
Set My_Message = Nothing
Set List_Recipients = Nothing
 
End Sub