Envoi de mail auto VBA d'une cellule à une autre + selection de plusieurs PJ

Version imprimable

Bonjour,

Je rencontre un petit souci avec mon code VBA (je suis débutant), j'ai pour objectif de programmer à l'aide d'une macro, un envoi de mail via Outlook. Ce mail contient un template qui est crée à base de RechercheV. A l'interieur de ce mail, j'aimerai y joindre plusieurs Pj, vous apercevrez plus bas que mon code n'est pas très très optimisé ahah, dû au faite que pour envoyer plusieurs pj j'ai du réaliser un code qui me permettais d'envoyer une seul PJ et ensuite faire un LoopUntil.
J'aimerais savoir si il est possible de choisir plusieurs Pj à la fois lorsque je clique sur la macro ?

Pour l'envoie de mail je n'arrive pas à mettre plusieurs personnes en copi, j'ai essayé plusieurs méthodes mais je n'y arrives pas :/.

Pour finir j'utilise une macro qui me permet d'envoyer ce que je selectionne c'est à dire de la cellule A4 à F16 et je me pose la question suivante : est il possible au lieu de selectionner l'ensemble du template, de dire au code de directement envoyer le mail de la cellule A4 a F16 ?

Je vous remercie ;)

Voici le 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 Bouton1_Cliquer() Dim oOutlook As Object Set oOutlook = CreateObject("Outlook.Application") Dim oMail As Object Set oMail = oOutlook.CreateItem(0) Dim Fichier As Variant With oMail Dim oObjetWord As Object Set oObjetWord = .GetInspector.WordEditor .to = "test@outlook.com" .CC = "test@gmail.com" ; "test2@gmai.com" .Subject = "Devis SR: " & Range("a5") & " / " & Range("b5") & " / " & Range("c5") .Body = ActiveCell Selection.Copy oObjetWord.Range(0).Paste .Display End With Do Fichier = Application.GetOpenFilename("Tous les fichiers(*.*),*.*") MsgBox Fichier ajoutpj = MsgBox("Ajouter une autre pièce jointe ?", vbYesNo, "Ajout Pièce Jointe") oMail.attachments.Add Fichier Loop Until ajoutpj = vbNo oMail.Send Set oOutlook = Nothing MsgBox " Votre mail à bien été envoyé." End Sub
Merci à vous !

10/08/2022, 13h28
Philippe Tulliez
Bonjour,
Je vous suggère de découper votre programme en plusieurs petits morceaux avec par exemple
- une procédure (Function) qui permet de sélectionner les pièces jointes en renvoyant dans une variable tableau (Array) les fichiers sélectionnés. Il existe une propriété FileDialog de l'objet Application qui permet d'utiliser des boîtes de dialogues natives d'excel.
- une procédure qui envoie les mails avec comme paramètres (Destinataire, les adresses en copie, texte à insérer dans le corps du mail, etc. et un paramètre pour recevoir la variable tableau des pièces à joindre)
Ainsi vous pourrez réutiliser ces procédures dans d'autres applications et les améliorer dans l'avenir.
Cela facilite grandement la maintenance

Bonjour,

En partie comme le recommande Philippe, que je salue au passage, voir si ceci le fait (la partie Word n'ayant pas été vérifiée):

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
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
Option Explicit
 
Sub Bouton1_Cliquer()
    Dim oOutlook As Object
    Set oOutlook = CreateObject("Outlook.Application")
 
    Dim oMail As Object
    Set oMail = oOutlook.CreateItem(0)
 
    Dim Fichier As Variant
    Dim AjoutPj As Variant
 
    With oMail
 
        Dim oObjetWord As Object
        Set oObjetWord = .GetInspector.WordEditor
 
        .To = "test1@outlook.com; test2@outlook.com; "  '--- adresses séparées par des ;
        .CC = "test1@gmail.com; test2@gmail.com; "
        .Subject = "Devis SR: " & Range("a5") & " / " & Range("b5") & " / " & Range("c5")
        .Body = ActiveCell
         Selection.Copy
         oObjetWord.Range(0).Paste
        .attachments.Add ListePJ_1      '--- liste pièces jointes
        .Display
'        .Send
    End With
 
    Set oOutlook = Nothing
'    MsgBox " Votre mail à bien été envoyé."
End Sub
 
Public Function ListePJ_1() As String   '--- pj sélectionnées une à une
    Dim AjoutPj As Variant
    Dim Fichier As Variant
    Dim sPJ As Variant
    sPJ = ""
    Do
        AjoutPj = MsgBox("Ajouter une autre pièce jointe ?", vbYesNo, "Ajout Pièce Jointe")
        If AjoutPj = vbYes Then
            Fichier = Application.GetOpenFilename("Tous les fichiers(*.*),*.*")
            If Fichier <> False Then        '--- clic sur Annuler = False
                sPJ = sPJ & Fichier & "; "
            End If
        End If
    Loop Until AjoutPj = vbNo
    ListePJ_1 = sPJ
End Function
 
Public Function ListePJ_2() As String   '--- pj toutes dans le même dossier
    Dim n As Long, sPJ As String
    sPJ = ""
    If MsgBox("Ajouter une ou plusieurs pièces jointes ?", vbYesNo, "Ajout Pièce Jointe") = vbYes Then
        With Application.FileDialog(msoFileDialogOpen)
            .InitialView = msoFileDialogViewDetails
            .InitialFileName = ThisWorkbook.Path & "\"      '--- adresse dossier présenté
            .AllowMultiSelect = True                        '--- sélection multiple autorisée
            .Show
            For n = 1 To .SelectedItems.Count
                sPJ = sPJ & .SelectedItems(n) & "; "
            Next n
        End With
    End If
    ListePJ_2 = sPJ
End Function

Cordialement.