Bonjour,

Petite question, j'aimerais automatiser l'envoie d'un mail de bienvenue avec une pièce jointe. Problème, la pièce joint est au format word (doctx pour être précise) et plusieurs personnes sont amenés à utiliser cette fonctionnalité. J'ai donc pensé à mettre le document sur un Sharepoint ou sur un Onedrive mais cela créer des conflits étant donné que le fichier est stocké sur le cloud et donc modifiable. Il faudrait qu'une copie soit jointe ou je ne sais pas exactement...

Peut-être auriez vous une meilleure idée, à laquelle je n'aurais pas pensé?

Merci d'avance !!

Pour les curieux mon code se structurait comme ça :

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Public Sub Envoi_Mail_DCO(typeMail As String, etatInitial As String)
 
    ' On définit tout nos objets
    Dim OutApp As Object, OutMail As Object, Signature As String
    Dim cell As Range, rng As Range, rngSelection As Range
    Dim candidatsSheet As Worksheet, mailSheet As Worksheet
    Dim eMail As String
    Dim PRENOM As String
    Dim NOM As String
    Dim etatDCO As String, etatTest As String
    Dim corpsTexte As String, formuleBonjour As String
    Dim sujet As String
    Dim ETAT As String
    Dim colPrenom As Integer
    Dim colNom As Integer
    Dim colMail As Integer
    Dim colDCO As Integer
    Dim colTest As Integer
    Dim colRelanceDCO As Integer
    Dim colRelanceTest As Integer
    Dim filePath1 As String
    filePath1 = "lienquiposepb.docx"
    Dim filePath2 As String
    filePath2 = "lienquiposepb.doctx"
 
    Dim NombreEmails As Integer
    NombreEmails = 0
 
    Set OutApp = CreateObject("Outlook.Application")
    Set candidatsSheet = Worksheets("CANDIDATS") ' Feuille des candidats
    Set mailSheet = Worksheets("MAIL") ' Feuille des mails
    Set rngSelection = Selection 'Sélection
 
    'Trouver les colonnes
    colPrenom = Cherche_ColonneXL(candidatsSheet, "PRENOM")
    colNom = Cherche_ColonneXL(candidatsSheet, "NOM")
    colMail = Cherche_ColonneXL(candidatsSheet, "MAIL")
    colDCO = Cherche_ColonneXL(candidatsSheet, "DCO")
    colTest = Cherche_ColonneXL(candidatsSheet, "TEST Technique")
    colRelanceDCO = Cherche_ColonneXL(candidatsSheet, "RELANCE DCO")
    colRelanceTest = Cherche_ColonneXL(candidatsSheet, "RELANCE TEST")
 
    ' On empêche la sélection de plusieurs lignes
    If Selection.Columns.count > 1 Then
        MsgBox "Merci de ne sélectionner qu'une seule colonne. Vous pouvez uniquement sélectionner plusieurs lignes.", vbExclamation, "Erreur"
        Exit Sub
    Else
 
        ' On récupère la signature enregistrée dans Outlook
        Set OutMail = OutApp.CreateItem(0)
        Signature = OutMail.HTMLBody
        OutMail.Close False ' Ferme le mail utilisé pour récupérer la signature sans l'envoyer
 
        ' Si une seule cellule est sélectionnée
        If rngSelection.Cells.count = 1 Then
            Set rng = rngSelection
        Else
            On Error Resume Next
            Set rng = rngSelection.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End If
 
        If rng Is Nothing Then
            MsgBox "Il n'y a pas de cellules visibles dans la sélection."
            Exit Sub
        End If
 
        For Each cell In rng
            eMail = candidatsSheet.Cells(cell.Row, colMail).Value
            PRENOM = candidatsSheet.Cells(cell.Row, colPrenom).Value
            NOM = candidatsSheet.Cells(cell.Row, colNom).Value
            etatDCO = candidatsSheet.Cells(cell.Row, colDCO).Value
            etatTest = candidatsSheet.Cells(cell.Row, colTest).Value
 
            If eMail <> "" And Not cell.EntireRow.Hidden Then
                If etatDCO = "Pas envoyé" And typeMail = "DCO" And etatInitial = "Pas envoyé" Then
                    ETAT = "DCO - Pas envoyé"
                ElseIf etatDCO = "Envoyé / Pas réalisé" And typeMail = "DCO" And etatInitial = "Envoyé / Pas réalisé" Then
                    ETAT = "DCO - Envoyé / Pas réalisé"
                ElseIf etatTest = "Pas envoyé" And typeMail = "TEST" And etatInitial = "Pas envoyé" Then
                    ETAT = "TEST - Pas envoyé"
                ElseIf etatTest = "Envoyé / Pas réalisé" And typeMail = "TEST" And etatInitial = "Envoyé / Pas réalisé" Then
                    ETAT = "TEST - Envoyé / Pas réalisé"
                Else
                    GoTo NextIteration
                End If
 
                NombreEmails = NombreEmails + 1
 
                corpsTexte = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 2).Value
                sujet = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 3).Value
 
                formuleBonjour = "Bonjour " & PRENOM & ",<br><br>"
 
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = eMail
                    .Subject = sujet
                    .Display ' Affiche l'aperçu avant d'envoyer encore une fois
                    .HTMLBody = formuleBonjour & corpsTexte & "<br>" & .HTMLBody
 
                If etatDCO = "Pas envoyé" And typeMail = "DCO" Then
                     OutMail.Attachments.Add filePath1
                     OutMail.Attachments.Add filePath2
 
                 End If
 
                End With
                Set OutMail = Nothing
 
                If rng.Rows.count = 2 Then Exit For '
 
            End If
NextIteration:
      Next cell
 
      If NombreEmails = 0 Then ' Si aucun e-mail n'a été envoyé
          MsgBox "Aucun e-mail ne correspond à votre relance. Veuillez vérifier les conditions de votre sélection."
      End If
 
    End If
    Set OutApp = Nothing
 
End Sub