Como enviar vários rascunhos de uma vez no Outlook?

Autor: Xiao Yang Última modificação: 2024-09-03

Se houver vários rascunhos de mensagens em sua pasta Rascunhos, e agora você deseja enviá-los de uma vez, sem enviar um por um. Como você poderia lidar com esse trabalho de forma rápida e fácil no Outlook?

Envie todas as mensagens de rascunho de uma vez no Outlook com código VBA

Envie todas as mensagens de rascunho de uma vez no Outlook com código VBA

Os seguintes códigos VBA podem ajudá-lo a enviar todos os e-mails de rascunho ou alguns selecionados da pasta Rascunhos de uma só vez, faça o seguinte:

1. Segure o ALT + F11 chaves para abrir o Microsoft Visual Basic para Aplicações janela.

2. Então clique inserção > Módulo, copie e cole o código abaixo no módulo em branco aberto, veja a captura de tela:

Código VBA: envie todos os rascunhos de e-mails de uma vez no 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

etapas para enviar todas as mensagens de rascunho de uma vez no Outlook com código VBA

3. Em seguida, salve o código e pressione F5 para executar este código, uma caixa de prompt aparecerá para lembrá-lo se enviar todos os rascunhos, clique Sim, veja a captura de tela:

4. E uma caixa de diálogo aparecerá para lembrá-lo de quantos rascunhos de e-mails foram enviados, veja a captura de tela:

5. E, em seguida, clique em OK botão, todos os e-mails no Esboços pasta será enviada de uma vez, veja a imagem:

Observações:

1. O código acima enviará todos os rascunhos de e-mails de todas as contas em seu Outlook.

2. Se você deseja apenas enviar alguns e-mails específicos da pasta Rascunhos, aplique o seguinte código VBA:

Código VBA: Envie e-mails selecionados da pasta Rascunhos:

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

AI Mail Assistant no Outlook: respostas mais inteligentes, comunicação mais clara (mágica de um clique!) GRATUITA

Simplifique suas tarefas diárias do Outlook com o AI Mail Assistant do Kutools for Outlook. Esta ferramenta poderosa aprende com seus e-mails anteriores para oferecer respostas inteligentes e precisas, otimizar o conteúdo do seu e-mail e ajudá-lo a redigir e refinar mensagens sem esforço.

Este recurso oferece suporte a:

Respostas inteligentes: obtenha respostas elaboradas a partir de suas conversas anteriores – personalizadas, precisas e prontas para uso.
Conteúdo aprimorado: refine automaticamente o texto do seu e-mail para maior clareza e impacto.
Composição sem esforço: basta fornecer palavras-chave e deixar a IA cuidar do resto, com vários estilos de escrita.
Extensões inteligentes: expanda seus pensamentos com sugestões baseadas no contexto.
Resumo: Obtenha visões gerais concisas de e-mails longos instantaneamente.
Alcance global: traduza seus e-mails para qualquer idioma com facilidade.

Este recurso oferece suporte a: