Come inviare più bozze contemporaneamente in Outlook?

Author: Xiaoyang Last Modified: 2025-08-06

Se ci sono più messaggi di bozza nella cartella Bozze e ora desideri inviarli tutti insieme senza doverli inviare uno per uno, come potresti gestire rapidamente e facilmente questa operazione in Outlook?

Invia tutte le email di bozza contemporaneamente in Outlook con il codice VBA

Invia tutte le email di bozza contemporaneamente in Outlook con il codice VBA

Il seguente codice VBA può aiutarti a inviare tutte o le email di bozza selezionate dalla cartella Bozze in una volta sola. Procedi come segue:

1. Tieni premuti i tasti ALT + F11 per aprire la finestra Microsoft Visual Basic for Applications.

2. Quindi fai clic su Inserisci > Modulo, copia e incolla il codice sottostante nel modulo vuoto aperto, vedi screenshot:

Codice VBA: Invia tutte le email di bozza contemporaneamente in 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

steps on sendig all draft messages at once in Outlook with VBA code

3. Salva quindi il codice e premi il tasto F5 per eseguire questo codice; apparirà una finestra di dialogo per chiederti se vuoi inviare tutte le bozze. Clicca su Sì, vedi screenshot:

4. Apparirà una finestra di dialogo per informarti di quante email di bozza sono state inviate, vedi screenshot:

5. Quindi fai clic sul pulsante OK e tutte le email nella cartella Bozze verranno inviate contemporaneamente, vedi screenshot:

Note:

1. Il codice sopra invierà tutte le email di bozza da tutti gli account nel tuo Outlook.

2. Se desideri inviare solo alcune email specifiche dalla cartella Bozze, applica il seguente codice VBA:

Codice VBA: Invia email selezionate dalla cartella Bozze:

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

Assistente AI per la Posta in Outlook: Risposte più intelligenti, comunicazione più chiara (magia con un clic!) GRATIS

Semplifica le tue attività quotidiane di Outlook con l'Assistente AI per la Posta di Kutools per Outlook. Questo potente strumento impara dalle tue email precedenti per offrire risposte intelligenti e accurate, ottimizzare il contenuto delle tue email e aiutarti a redigere e perfezionare i messaggi senza sforzo.

Questa funzione supporta:

Risposte Intelligenti: Ottieni risposte create a partire dalle tue conversazioni passate—personalizzate, precise e pronte all'uso.
Contenuto Migliorato: Perfeziona automaticamente il testo delle tue email per chiarezza e impatto.
Composizione Senza Sforzo: Fornisci solo delle parole chiave e lascia che l'IA si occupi del resto, con diversi stili di scrittura.
Estensioni Intelligenti: Espandi i tuoi pensieri con suggerimenti contestuali.
Riassunti: Ottieni sintesi concise di email lunghe istantaneamente.
Portata Globale: Traduci le tue email in qualsiasi lingua con facilità.

Questa funzione supporta:

Risposte intelligenti alle email
Contenuto ottimizzato
Bozze basate su parole chiave
Estensione intelligente del contenuto
Riassunto delle email
Traduzione multilingue

Il meglio di tutto è che questa funzione è completamente gratuita per sempre! Non aspettare—scarica subito Assistente AI per la Posta e goditela

Articoli correlati:

Come inviare un'email a più destinatari individualmente in Outlook?

Come inviare email personalizzate di massa da un elenco Excel tramite Outlook?

Come inviare un calendario a più destinatari individualmente in Outlook?

Come inviare un'email a più destinatari senza che loro lo sappiano in Outlook?