Comment envoyer plusieurs brouillons à la fois dans Outlook?
S'il y a plusieurs brouillons de messages dans votre dossier Brouillons, et maintenant, vous voulez les envoyer en même temps sans les envoyer un par un. Comment pourriez-vous gérer ce travail rapidement et facilement dans Outlook?
Envoyer tous les brouillons de messages à la fois dans Outlook avec le code VBA
Envoyer tous les brouillons de messages à la fois dans Outlook avec le code VBA
Les codes VBA suivants peuvent vous aider à envoyer tous ou certains brouillons d'e-mails à partir du dossier Brouillons en même temps, procédez comme suit:
1. Maintenez le ALT + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.
2. Puis clique insérer > Module, copiez et collez le code ci-dessous dans le module vide ouvert, voir capture d'écran:
Code VBA: envoyez tous les brouillons d'e-mails à la 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. Enregistrez ensuite le code et appuyez sur F5 clé pour exécuter ce code, une boîte de dialogue apparaîtra pour vous rappeler si envoyer tous les brouillons, cliquez sur Oui, voir capture d'écran:
4. Et une boîte de dialogue apparaîtra pour vous rappeler combien de brouillons d'e-mails ont été envoyés, voir capture d'écran:
5. Et puis cliquez OK bouton, tous les e-mails dans le Brouillons le dossier sera envoyé à la fois, voir capture d'écran:
Notes:
1. Le code ci-dessus enverra tous les brouillons d'e-mails de tous les comptes dans votre Outlook.
2. Si vous souhaitez simplement envoyer des e-mails spécifiques à partir du dossier Brouillons, veuillez appliquer le code VBA suivant:
Code VBA: envoyez les e-mails sélectionnés à partir du 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 connexes:
Comment envoyer un e-mail à plusieurs destinataires individuellement dans Outlook?
Comment envoyer des e-mails de masse personnalisés à une liste à partir d'Excel via Outlook?
Comment envoyer un calendrier à plusieurs destinataires individuellement dans Outlook?
Comment envoyer un e-mail à plusieurs destinataires sans qu'ils le sachent dans Outlook?
Kutools for Outlook - Apporte 100 fonctionnalités avancées à Outlook et simplifie grandement le travail!
- CC / BCC automatique par des règles lors de l'envoi d'e-mails; Transfert automatique Emails multiples par coutume; Réponse automatique sans serveur d'échange, et plus de fonctionnalités automatiques ...
- Avertissement BCC - afficher le message lorsque vous essayez de répondre à tous si votre adresse e-mail est dans la liste BCC; Rappeler en cas de pièces jointes manquantes, et plus de fonctionnalités de rappel ...
- Répondre (à tous) avec toutes les pièces jointes dans la conversation par courrier électronique; Répondre à de nombreux e-mails en secondes; Ajouter un message d'accueil automatique quand répondre; Ajouter la date au sujet ...
- Outils de pièces jointes: gérer toutes les pièces jointes dans tous les courriers, Détachement automatique, Compresser tout, Tout renommer, Tout enregistrer ... Rapport rapide, Compter les courriers sélectionnésplus
- Courriels indésirables puissants par coutume; Supprimer les messages et contacts en doubleplus Vous permettre de faire plus intelligemment, plus rapidement et mieux dans Outlook.
















