Envoi pièce jointe sur Outlook via VBA

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 :

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

bonjour,

je te remercie pour ton retour sur ta question précédente.

Bonjour, je suis vraiment désolée j'étais convaincue d'avoir répondue !
je n'ai pas trouvé de solution idéale mais votre idée m'a bien aidée à détourner un peu le problème. Je n'ai plus de boucle infinie mais un petit soucis lorsque l'utilisateur sélectionne deux lignes. C'est déjà mieux. Encore désolée de ne pas avoir répondue....