Hello,

Voici la macro, elle fonctionne seulement si le nom du dossiers n'a pas d'espace

Comment faire si le dossier se nomme : mon test ?

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
Option Explicit
Sub EnvoiMail_Compta_Conditions_commerciales()
    Dim Feuille_Active As Worksheet
        Set Feuille_Active = ActiveSheet
        Application.ScreenUpdating = False ' Désactive le changement des pages à l'écran lors de l'éxécution de la macro
'Première question
        If MsgBox("As-tu signé et fermé le document pdf ?", vbYesNo + vbQuestion, "Avant d'envoyer le mail") = vbYes Then
'Si oui à la première question
'Deuxième question
        If MsgBox("Inscrire l'action effectuée dans le journal du projet ?", vbYesNo + vbQuestion, "") = vbYes Then
'Si oui à la deuxième question
        Insérer_une_ligne_Journal.InsérerLigneJournal
        Sheets("Journal du projet").Range("E15") = "Mail envoyé à la compta : " & Range("Cell_Conditions_commerciales_Titre")
 
'Réactive la feuille de départ du lancementde la macro
        Feuille_Active.Select
        Application.ScreenUpdating = True ' Désactive le changement des pages à l'écran lors de l'éxécution de la macro
    EnvoiMail_Compta.EnvoiMail_Compta_Conditions_commerciales_OK
Else
'Si non à la deuxième question
    EnvoiMail_Compta.EnvoiMail_Compta_Conditions_commerciales_OK
End If
Else
'Si non à la première question
'Ne rien faire
End If
End Sub
Sub EnvoiMail_Compta_Conditions_commerciales_OK()
        Dim NomPrenomDutilisateur As Variant
        Dim Classeur_Actif As Workbook
        Dim vaMsg As Variant
        Dim stSubject As Variant
        Dim Srep As String
        Dim Nom_du_PDF As String
        Dim messagerie As Object
        Dim email As Object
        Dim Dossier_projet As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'On Error GoTo Description_erreur
        NomPrenomDutilisateur = Application.UserName 'Environ("USERNAME")
'Création du mail avec Outlook
    Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    stSubject = Range("Cell_Conditions_commerciales_Titre")
'Corps du mail, construction du texte à adapter selon volonté
        vaMsg = "<p style='font-family:calibri;font-size:14.5'>" & _
        "Vérifier les destinataires du mail :<br>" & _
        "A: Compta<br>" & _
        "CC: <br>" & _
        "Vérifier la signature du mail<br><br>" & _
        "<A href=" & (ThisWorkbook.Path) & ">! Ctrl+clic pour ouvrir le dossier et attacher la lettre signée par le VI !</A>" & "<br><br>" & _
        "Texte ci-dessus à effacer une fois les points vérifiés<br>" & _
        "_________________________________________________________<br>" & _
        "Bonjour, <br><br>" & _
        "En pièce jointe le document signé cité en titre<br><br>" & _
        "Merci et meilleures salutations<br><br>" & _
        NomPrenomDutilisateur & _
        "<br><br>"
 
'Boîte de message si OK
    MsgBox _
    "À… " & _
    vbCrLf & vbCrLf & _
    "Cc… " & _
    vbCrLf & vbCrLf & _
    "Objet : " & stSubject _
    , vbInformation, "Le mail suivant est prêt à être envoyé :"
    With email
        .To = ""
        .CC = ""
        .Subject = stSubject
        .HTMLBody = vaMsg
'        .Attachments.Add (Srep & Nom_du_PDF)
        .Display
End With
    Set email = Nothing
    Set messagerie = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
Description_erreur:
                MsgBox _
                "- " & Err.Description & vbCrLf & vbCrLf & _
                "- Vérifier que le choix de la succursale est correct dans les Partenaires" & vbCrLf & vbCrLf & _
                "- Le fichier doit être enregistré" & _
                "", vbExclamation, "! Oups !"
End Sub