Note: The other languages of the website are Google-translated. Back to English

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.
tir kutools outlook onglet kutools 1180x121
tir kutools outlook kutools plus onglet 1180x121
 
Commentaires (15)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
Génial, a fonctionné un charme, merci :)
Ce commentaire a été minimisé par le modérateur sur le site
einfach nur perfekt. Herzlichen Dank
Ce commentaire a été minimisé par le modérateur sur le site
Copié comme ci-dessus mais lorsque j'appuie sur F5 rien ne se passe
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Catleen,
Le code ci-dessus fonctionne bien dans mon Outlook, quelle version d'Outlook utilisez-vous ?
Ce commentaire a été minimisé par le modérateur sur le site
J'ai plusieurs comptes d'échange. Je veux que l'un des comptes qui n'est pas mon compte par défaut soit l'expéditeur. Où dois-je insérer cela dans le code ? Merci!
Ce commentaire a été minimisé par le modérateur sur le site
Quelqu'un reçoit-il des e-mails envoyés au dossier supprimé en faisant cela ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut Bill,
Voulez-vous envoyer plusieurs e-mails sélectionnés à partir du dossier supprimé ?
Veuillez détailler votre problème, merci !
Ce commentaire a été minimisé par le modérateur sur le site
Salut skyyang, je suis confronté au même problème. Je rédige généralement 15 à 20 e-mails, puis j'utilise ce code pour les envoyer tous en même temps, mais je me rends compte plus tard que l'un de ces e-mails n'est pas envoyé, mais plutôt dans mon dossier "Supprimé". Même l'invite indique le nombre correct d'e-mails pour, par exemple : "20 e-mails envoyés", mais lorsque je vérifie, seuls 19 auraient été envoyés, un que je trouverai dans mon dossier des éléments supprimés. Je veux que tous les e-mails soient envoyés à leurs destinataires sans erreur. Pouvez-vous s'il vous plaît me dire pourquoi cela se produit. S'il vous plaît aider.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, Darewin, nous avons mis à jour les codes ci-dessus, veuillez réessayer, merci !
Ce commentaire a été minimisé par le modérateur sur le site
Même problème : si vous sélectionnez 4 messages, après avoir envoyé trois d'entre eux dans la corbeille (à cause de l'instruction "xDraftsItems.Item(i).Delete")
Ce commentaire a été minimisé par le modérateur sur le site
Nous avons utilisé le script pour envoyer tous les brouillons d'e-mails en même temps pour un lot d'e-mails de relevé générés à partir de sage 200. Les e-mails dans les éléments envoyés semblent corrects, mais les clients les reçoivent avec le corps du texte en chinois ! Des idées sur ce qui pourrait se passer ici?
Ce commentaire a été minimisé par le modérateur sur le site
Pouvez-vous expliquer pourquoi le dernier courrier (i = 1) est recréé dans un nouveau MailItem au lieu de simplement .Send ?

Merci.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, petite question peut-être que tu as une idée. Nous avons une application externe qui enregistre tous les e-mails dans le dossier des brouillons. si j'exécute la macro, nous avons le problème que seul le premier courrier de la liste est envoyé correctement, tous les autres courriers sont différés car ils ajoutent des guillemets "" à l'adresse e-mail. Existe-t-il un moyen d'éviter cela ?
Ce commentaire a été minimisé par le modérateur sur le site
Ce code envoie tous les brouillons dans un sous-dossier appelé Merge Tools (il vous le demande avant l'envoi). Je suis sûr que vous pouvez le modifier en fonction de vos besoins. C'est beaucoup plus simple. Prendre plaisir :)
Sub SendAllMergeToolsDrafts()

Si MsgBox("Êtes-vous sûr de vouloir envoyer TOUS les éléments de votre dossier de brouillons de Merge Tools ?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace As Outlook.NameSpace 'Changer la vue en boîte de réception pour éviter les erreurs en ligne
Set myNamespace = Application.GetNamespace("MAPI") 'Changer la vue en boîte de réception pour éviter les erreurs en ligne
Définir Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Changer la vue en boîte de réception pour éviter les erreurs en ligne

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Envoie tous les brouillons dans le dossier Merge Tools uniquement
nombre entier = 0
Faire tant que fldDraft.Items.count > 0
Définir msg = fldDraft.Items(1)
msg.Envoyer
intCount = intCount + 1
boucle
Si non (msg n'est rien) alors définissez msg = rien
Set fldDraft = Rien
MsgBox intCount & " messages envoyés", vbInformation + vbOKOnly

End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut les gars. Je pensais partager. Voici mon code pour envoyer tous les brouillons :
Sub SendAllDrafts() 'Par jamesmalcolmwood@gmail.com

Si MsgBox("Êtes-vous sûr de vouloir envoyer TOUS les éléments de votre dossier de brouillons ?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace As Outlook.NameSpace 'Changer la vue en boîte de réception pour éviter les erreurs en ligne
Set myNamespace = Application.GetNamespace("MAPI") 'Changer la vue en boîte de réception pour éviter les erreurs en ligne
Définir Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Changer la vue en boîte de réception pour éviter les erreurs en ligne

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Envoie tous les brouillons dans votre dossier de brouillons principal. Pour un sous-dossier, ajoutez .Folders("nom du dossier")
nombre entier = 0
Faire tant que fldDraft.Items.count > 0
Définir msg = fldDraft.Items(1)
msg.Envoyer
intCount = intCount + 1
boucle
Si non (msg n'est rien) alors définissez msg = rien
Set fldDraft = Rien
MsgBox intCount & " messages envoyés", vbInformation + vbOKOnly

End Sub
Il n'y a pas encore de commentaires postés ici
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés

Nous suivre

Copyright © 2009 - www.extendoffice.com. | Tous les droits sont réservés. Alimenté par ExtendOffice. | | Plan du site
Microsoft et le logo Office sont des marques commerciales ou des marques déposées de Microsoft Corporation aux États-Unis et / ou dans d'autres pays.
Protégé par Sectigo SSL