Comment envoyer plusieurs brouillons d’un seul coup dans Outlook ?

Si plusieurs messages brouillons se trouvent dans votre dossier Brouillons et que vous souhaitez les envoyer tous en une seule fois, sans devoir les expédier un par un, comment réaliser cette opération rapidement et facilement dans Outlook ?

Envoyer tous les messages brouillons en une seule fois dans Outlook à l’aide d’un code VBA

---

Envoyer tous les messages brouillons en une seule fois dans Outlook à l’aide d’un code VBA

Les codes VBA suivants vous permettent d’envoyer simultanément tous les e-mails en brouillon ou uniquement ceux que vous avez sélectionnés depuis le dossier Brouillons. Voici la marche à suivre :

1. Maintenez enfoncées les touches ALT + F11 pour ouvrir la fenêtre Microsoft Visual Basic pour Applications.

2. Cliquez ensuite sur Insertion > Module, puis copiez et collez le code ci-dessous dans le module vide qui s’ouvre (voir capture d’écran) :

Code VBA : Envoyer tous les e-mails brouillons en une seule fois dans Outlook :

Sub SendAllDraftEmails()
Dim xAccount As Account
Dim xDraftFld As Folder
Dim xItemCount As Integer
Dim xCount As Integer
Dim xDraftsItems As Outlook.Items
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xCurFld As Folder
Dim xTmpFld As Folder
On Error Resume Next
xItemCount = 0
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
    Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
    xItemCount = xItemCount + xDraftFld.Items.Count
    If xDraftFld.EntryID = xCurFld.EntryID Then
        Set xTmpFld = xCurFld.Parent
    End If
Next xAccount
Set xDraftFld = Nothing
If xItemCount > 0 Then
   xPromptStr = "Are you sure to send out all the drafts?"
    xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
    If xYesOrNo = vbYes Then
        If Not xTmpFld Is Nothing Then
            Set Application.ActiveExplorer.CurrentFolder = xTmpFld
        End If
        VBA.DoEvents
        For Each xAccount In Outlook.Application.Session.Accounts
            Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
            Set xDraftsItems = xDraftFld.Items
            For i = xDraftsItems.Count To 1 Step -1
                If xDraftsItems.Item(i).Recipients.Count <> 0 Then
                    xDraftsItems.Item(i).sEnd
                    xCount = xCount + 1
                End If
            Next
        Next xAccount
        VBA.DoEvents
        Set Application.ActiveExplorer.CurrentFolder = xCurFld
        MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
    End If
Else
    MsgBox "No Drafts!", vbInformation + vbOKOnly, "Kutools for Outlook"
End If
End Sub

3. Ensuite, enregistrez le code et appuyez sur la touche F5 pour exécuter ce code. Une boîte de dialogue s’affichera pour vous demander si vous souhaitez envoyer tous les brouillons ; cliquez sur Oui (voir capture d’écran).

4. Une autre boîte de dialogue s’affiche alors pour vous indiquer combien d’e-mails brouillons ont été envoyés (voir la capture d’écran).

5. Cliquez ensuite sur le bouton OK, et tous les e-mails du dossier Brouillons seront envoyés simultanément (voir capture d’écran).

Remarques :

1. Le code ci-dessus envoie tous les e-mails en brouillon de tous les comptes configurés dans votre Outlook.

2. Si vous souhaitez envoyer uniquement certains e-mails précis depuis le dossier Brouillons, utilisez plutôt le code VBA suivant :

Code VBA : Envoyer les e-mails sélectionnés depuis le dossier Brouillons :

Sub SendSelectedDraftEmails()
Dim xSelection As Selection
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xAccount As Account
Dim xCurFld As Folder
Dim xDraftsFld As Folder
Dim xTmpFld As Folder
Dim xArr() As String
Dim xCount As Integer
Dim xMail As MailItem
On Error Resume Next
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
    Set xDraftsFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
    If xDraftsFld.EntryID = xCurFld.EntryID Then
        Set xTmpFld = xCurFld.Parent
    End If
Next xAccount
If xTmpFld Is Nothing Then
    MsgBox "The current folder is not a draft folder", vbInformation, "Kutools for Outlook"
    Exit Sub
End If
Set xSelection = Outlook.Application.ActiveExplorer.Selection
If xSelection.Count > 0 Then
    xPromptStr = "Are you sure to send out the selected " & xSelection.Count & " draft item(s)?"
    xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
    If xYesOrNo = vbYes Then
        ReDim xArr(xSelection.Count - 1)
        For i = 1 To xSelection.Count
            xArr(i - 1) = xSelection.Item(i).EntryID
        Next
        Set Application.ActiveExplorer.CurrentFolder = xTmpFld
        VBA.DoEvents
        For i = 0 To UBound(xArr)
            Set xMail = Application.Session.GetItemFromID(xArr(i))
            If xMail.Recipients.Count <> 0 Then
                xMail.sEnd
                xCount = xCount + 1
            End If
        Next
        VBA.DoEvents
        Set Application.ActiveExplorer.CurrentFolder = xCurFld
        MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
    End If
Else
    MsgBox "No items selected!", vbInformation, "Kutools for Outlook"
End If
End Sub

---

---

Articles associés :

Comment envoyer un e-mail à plusieurs destinataires individuellement dans Outlook ?

Comment envoyer des e-mails personnalisés en masse à partir d’une liste Excel via Outlook ?

Comment envoyer un calendrier à plusieurs destinataires, individuellement, dans Outlook ?

Comment envoyer un e-mail à plusieurs destinataires sans qu’ils ne le sachent dans Outlook ?