Microsoft 365 VBA - Save mail sur hard disk après envoi du mail

Azuveus

XLDnaute Nouveau
Bonjour la communauté,

Je recherche le moyen de sauvegarder un Email en (.msg) sur mon disque dur après qu'il ai été envoyé.
Précision :
- Le mail n'est pas visible
- Le mail est envoyé lorsque je clique sur un bouton dans un fichier Excel.

Voici mon code :
VB:
    Set ol = CreateObject("outlook.application")
    Set monItem = ol.CreateItem(olMailItem)
    monItem.Attachments.Add ("...\logo.jpg"), olByValue, 0
   
    'Récupération des variables
   
    CLIENT = TextBox1.Value
    ADRESSE = TextBox2.Value
    VILLE = TextBox3.Value
    CONTACT = TextBox9.Value
    TEL = TextBox7.Value
    FSE = TextBox54.Value
    DATE_LIVRAISON = TextBox55.Value
    INSTRUMENT = TextBox23.Value
    SO = TextBox12.Value
    AddFolder = SO & " - " & CLIENT & " - " & INSTRUMENT & "\"

    path = "...\ORDERS\"
    If Len(Dir(path & AddFolder, vbDirectory)) = 0 Then
    MkDir path, AddFolder
    End If

    'si le champs FSE est vide.
    If TextBox54.Value = "" Then
   
    FSE = "Non Défini à ce jour."
   
    End If
   
    'si le champs BL est vide.
    If TextBox78.Value <> "" Then
   
    'recupérer les pieces jointes
    Dim i As Integer
    Dim Var_traitement
   
    Var_traitement = SpliterChaine(TextBox78.Value, "+")
    For i = LBound(Var_traitement) To UBound(Var_traitement)
    Debug.Print Var_traitement(i)
    Next i
           
        If Var_traitement(0) <> 0 Then
            MyFileName1 = "...\BL\" + Var_traitement(0) + ".PDF"
        End If
       
        If i = 1 Then
        MyFileName2 = ""
        Else
            If Var_traitement(1) <> 0 Then
                MyFileName2 = "...\BL\" + Var_traitement(1) + ".PDF"
            End If
        End If
       
    End If
   
    NumCde = TextBox12.Value
    CdeClient = TextBox19.Value
    MailClient = TextBox50.Value
    INSTRUMENT = TextBox23.Value
    Signataire = ComboBox12.Value
    TRACKING = TextBox66.Value
    SEMAINE = TextBox63.Value
    STOCK = ComboBox9.Value
   
    MailLOGISTIC = "AAA@CCC.com"
    CopyR3 = "BBB@CCC.com"
   
    'Box Commentaire (avec Multilignes)
    INSTRUCTIONS = Replace(Me.TextBox76.Text, vbCrLf, "<Br>")
       
    monItem.SentOnBehalfOfName = "BBB@CCC.com"
    monItem.To = MailLOGISTIC
    monItem.CC = CopyR3
   
    'Deux PJ maximum dans le mail
    'Si les fichiers existes alors on les ajoutes :
   
    If TextBox78.Value <> "" Then
           
            If MyFileName1 <> "" Then
                    monItem.Attachments.Add (MyFileName1)
            End If
            If MyFileName2 <> "" Then
                monItem.Attachments.Add (MyFileName2)
            End If
       
    End If
   
    If CheckBox39.Value = False Then
   
        CheckBox39.Value = True
   
        '-------------------------------
        ' MAIL (1er ENVOI)
        '-------------------------------

        TitreMail = "SO " & NumCde & " - " & CLIENT & " - " & INSTRUMENT & " - " & " Livraison au : " & STOCK
        monItem.Subject = TitreMail

        monItem.HTMLBody = "CORPS DU MAIL"

       
    Else
   
        '-------------------------------
        ' MAIL (MISE A JOUR)
        '-------------------------------

        TitreMail = "SO " & NumCde & " - " & CLIENT & " - " & INSTRUMENT & " - " & " Livraison au : " & STOCK & " - MISE A JOUR DOSSIER"
        monItem.Subject = TitreMail

        monItem.HTMLBody = "CORPS DU MAIL"

    End If
         
        monItem.SaveAs "...\ORDERS\" & AddFolder + "[" & "MAIL" & "] " & "Instruction" & ".msg"
        monItem.Send
               
        Label96.Caption = Format(date_test, "Le d mmmm à h\hmm")
        MsgBox "Mail correctement envoyé."

Une copie du mail s'enregistre correctement sur mon disque dur, cependant il s'agit du brouillon du mail avant envoi... Ce qui n'est pas ce que je recherche.
Pourriez vous m'aider svp ?

Azuveus.
 

Statistiques des forums

Discussions
314 626
Messages
2 111 294
Membres
111 093
dernier inscrit
Yvounet