Como enviar vários rascunhos de uma vez no Outlook?
Se houver várias mensagens de rascunho na sua pasta Rascunhos e agora você deseja enviá-las todas de uma vez, sem precisar enviar uma por uma. Como você poderia lidar com essa tarefa de forma rápida e fácil no Outlook?
Enviar todas as mensagens de rascunho de uma vez no Outlook com código VBA
Enviar 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 ou os rascunhos selecionados da pasta Rascunhos de uma vez; por favor, faça o seguinte:
1. Pressione e segure as teclas ALT + F11 para abrir a janela do Microsoft Visual Basic for Applications.
2. Em seguida, clique em Inserir > Módulo, copie e cole o código abaixo no módulo em branco aberto, veja a captura de tela:
Código VBA: Enviar todos os rascunhos de email 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
3. Depois, salve o código e pressione a tecla F5 para executar este código; uma caixa de aviso aparecerá para lembrá-lo se deseja enviar todos os rascunhos; clique em Sim, veja a captura de tela:
4. E uma caixa de diálogo aparecerá para informar quantos emails de rascunho foram enviados, veja a captura de tela:
5. Em seguida, clique no botão OK, e todos os emails na pasta Rascunhos serão enviados de uma vez, veja a captura de tela:
Notas:
1. O código acima enviará todos os emails de rascunho de todas as contas no seu Outlook.
2. Se você quiser enviar apenas alguns emails específicos da pasta Rascunhos, aplique o seguinte código VBA:
Código VBA: Enviar emails 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
Assistente de E-mail AI no Outlook: Respostas mais Inteligentes, Comunicação mais Clara (mágica com um clique!) GRÁTIS
Simplifique suas tarefas diárias no Outlook com o Assistente de E-mail AI do Kutools para Outlook. Esta poderosa ferramenta aprende com seus e-mails anteriores para oferecer respostas inteligentes e precisas, otimizar o conteúdo de seus e-mails e ajudá-lo a criar e refinar mensagens sem esforço.
Este recurso suporta:
- Respostas Inteligentes: Receba respostas elaboradas a partir de suas conversas passadas — personalizadas, precisas e prontas para uso.
- Conteúdo Aprimorado: Refine automaticamente o texto de seus e-mails para maior clareza e impacto.
- Criação Sem Esforço: Basta fornecer palavras-chave e deixar a IA cuidar do resto, com múltiplos estilos de escrita.
- Extensões Inteligentes: Expanda seus pensamentos com sugestões contextualizadas.
- Resumo: Obtenha visões concisas de e-mails longos instantaneamente.
- Alcance Global: Traduza seus e-mails para qualquer idioma com facilidade.
Este recurso suporta:
- Respostas inteligentes de e-mail
- Conteúdo otimizado
- Rascunhos baseados em palavras-chave
- Extensão inteligente de conteúdo
- Resumo de e-mails
- Tradução multilíngue
O melhor de tudo é que este recurso é completamente grátis para sempre! Não espere — baixe agora o Assistente de E-mail AI e aproveite
Artigos Relacionados:
Como enviar um email para vários destinatários individualmente no Outlook?
Como enviar emails personalizados em massa para uma lista do Excel via Outlook?
Como enviar um Calendário para vários destinatários individualmente no Outlook?
Como enviar um email para vários destinatários sem que eles saibam no Outlook?
Melhores Ferramentas de Produtividade para Office
Notícia de Última Hora: Kutools para Outlook Lança Versão Gratuita!
Experimente agora a nova versão GRATUITA do Kutools para Outlook, com mais de70 recursos incríveis para você usar PARA SEMPRE! Clique para baixar agora!
📧 Automação de Email: Resposta automática (Disponível para POP e IMAP) / Agendar envio de emails / CC/BCC automático por Regra ao enviar email / Encaminhamento automático (Regra avançada) / Adicionar saudação automaticamente / Dividir automaticamente emails com múltiplos destinatários em mensagens individuais...
📨 Gerenciamento de Email: Recallar Email / Bloquear emails suspeitos por assunto e outros critérios / Excluir Emails Duplicados / Pesquisa Avançada / Organizar Pastas...
📁 Anexos Pro: Salvar em lote / Desanexar em lote / Comprimir em lote / Salvar automaticamente / Desanexar automaticamente / Auto Comprimir...
🌟 Interface Mágica: 😊Mais emojis bonitos e estilosos / Aviso quando emails importantes chegarem / Minimizar Outlook ao invés de fechar...
👍 Recursos com Um Clique: Responder a Todos com Anexos / Emails Anti-Phishing / 🕘Exibir o fuso horário do remetente...
👩🏼🤝👩🏻 Contatos & Calendário: Adicionar contatos em lote a partir de emails selecionados / Dividir um grupo de contatos em grupos individuais / Remover lembrete de aniversário...
