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

Hoe verstuur ik meerdere concepten tegelijk in Outlook?

Als er meerdere conceptberichten in uw map Concepten staan, en u wilt ze nu in één keer verzenden zonder ze een voor een te verzenden. Hoe kunt u deze klus snel en gemakkelijk afhandelen in Outlook?

Stuur alle conceptberichten tegelijk in Outlook met VBA-code


Stuur alle conceptberichten tegelijk in Outlook met VBA-code

De volgende VBA-codes kunnen u helpen om alle of geselecteerde concept-e-mails in één keer vanuit de map Concepten te verzenden, doe dit als volgt:

1. Houd de ALT + F11 toetsen om de te openen Microsoft Visual Basic voor toepassingen venster.

2. Dan klikken Invoegen > Module, kopieer en plak onderstaande code in de geopende lege module, zie screenshot:

VBA-code: stuur alle concept-e-mails tegelijk 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

3. Sla vervolgens de code op en druk op F5 toets om deze code uit te voeren, verschijnt er een promptvenster om u eraan te herinneren of alle concepten zijn verzonden, klik op Ja, zie screenshot:

4. En er verschijnt een dialoogvenster om u eraan te herinneren hoeveel concept-e-mails er zijn verzonden, zie screenshot:

5. En klik vervolgens op OK -knop, alle e-mails in de Concepten map wordt in één keer verzonden, zie screenshot:

Opmerkingen:

1. De bovenstaande code verzendt alle concept-e-mails van alle accounts in uw Outlook.

2. Als u alleen een aantal specifieke e-mails wilt verzenden vanuit de map Concepten, past u de volgende VBA-code toe:

VBA-code: stuur geselecteerde e-mails vanuit de map Concepten:

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

Gerelateerde artikelen:

Hoe stuur je een e-mail naar meerdere ontvangers afzonderlijk in Outlook?

Hoe stuur je gepersonaliseerde massa-e-mails naar een lijst vanuit Excel via Outlook?

Hoe stuur je een agenda naar meerdere ontvangers afzonderlijk in Outlook?

E-mail verzenden naar meerdere ontvangers zonder dat ze het weten in Outlook?


Kutools voor Outlook - Brengt 100 geavanceerde functies naar Outlook en maakt het werk veel gemakkelijker!

  • Auto CC / BCC volgens regels bij het verzenden van e-mail; Automatisch doorsturen Meerdere e-mails op maat; Auto antwoord zonder uitwisselingsserver, en meer automatische functies ...
  • BCC-waarschuwing - toon bericht wanneer u alle probeert te beantwoorden als uw e-mailadres in de BCC-lijst staat; Herinner bij ontbrekende bijlagen, en meer herinneren functies ...
  • Beantwoorden (alle) met alle bijlagen in het e-mailgesprek; Beantwoord veel e-mails in seconden; Begroeting automatisch toevoegen wanneer antwoord; Datum toevoegen aan onderwerp ...
  • Hulpmiddelen voor bijlagen: beheer alle bijlagen in alle e-mails, Automatisch loskoppelen, Alles comprimeren, Alles hernoemen, Alles opslaan ... Snel rapport, Tel geselecteerde e-mails...
  • Krachtige ongewenste e-mails op maat; Verwijder dubbele e-mails en contacten... Stel u in staat om slimmer, sneller en beter te doen in Outlook.
shot kutools outlook kutools tabblad 1180x121
shot kutools vooruitzichten kutools plus tabblad 1180x121
 
Heb je vragen? Stel ze hier. (15)
Nog geen beoordelingen. Beoordeel als eerste!
Deze opmerking is gemaakt door de moderator op de site
Briljant, werkte een charme, bedankt :)
Deze opmerking is gemaakt door de moderator op de site
einfach nur perfect. Herzlichen Dank
Deze opmerking is gemaakt door de moderator op de site
Gekopieerd zoals hierboven, maar als ik op F5 druk gebeurt er niets
Deze opmerking is gemaakt door de moderator op de site
Hallo, Cathleen,
Bovenstaande code werkt prima in mijn Outlook, welke Outlook-versie gebruik je?
Deze opmerking is gemaakt door de moderator op de site
Ik heb meerdere wisselrekeningen. Ik wil dat een van de accounts die niet mijn standaard is, de afzender is. Waar zou ik dit in de code moeten invoegen? Bedankt!
Deze opmerking is gemaakt door de moderator op de site
Heeft iemand een aantal e-mails naar de verwijderde map gekregen om dit te doen?
Deze opmerking is gemaakt door de moderator op de site
Hallo, Bill,
Wilt u meerdere geselecteerde e-mails verzenden vanuit verwijderde bestanden?
Geef uw probleem meer gedetailleerd, dank u!
Deze opmerking is gemaakt door de moderator op de site
Hallo Skyyang, ik heb hetzelfde probleem. Ik stel meestal 15-20 e-mails op en gebruik deze code om ze allemaal tegelijk te verzenden, maar realiseer me later dat een van die e-mails niet wordt verzonden, maar dat ze naar mijn map 'Verwijderd' worden gestuurd. Zelfs de prompt zegt het juiste aantal e-mails voor bijvoorbeeld: '20 e-mails verzonden', maar als ik het aanvink, zouden er slechts 19 zijn verzonden, waarvan ik één in de map met verwijderde items vind. Ik wil dat alle e-mails foutloos naar hun ontvangers worden verzonden. Kunt u mij alstublieft vertellen waarom dit gebeurt. Help alstublieft.
Deze opmerking is gemaakt door de moderator op de site
Hallo, Darewin, We hebben de bovenstaande codes bijgewerkt, probeer het opnieuw, bedankt!
Deze opmerking is gemaakt door de moderator op de site
Hetzelfde probleem: als je 4 berichten selecteert, komen er drie in de prullenbak terecht (vanwege de "xDraftsItems.Item(i).Delete"-instructie)
Deze opmerking is gemaakt door de moderator op de site
We hebben het script gebruikt om alle concept-e-mails in één keer te verzenden voor een reeks e-mails met verklaringen die zijn gegenereerd op basis van Sage 200. De e-mails in de verzonden items zien er goed uit, maar klanten ontvangen ze met de hoofdtekst in het Chinees! Enig idee wat hier aan de hand kan zijn?
Deze opmerking is gemaakt door de moderator op de site
Kun je uitleggen waarom de laatste e-mail (i = 1) opnieuw wordt gemaakt in een nieuw MailItem in plaats van alleen in .Send?

Bedankt.
Deze opmerking is gemaakt door de moderator op de site
Hallo, korte vraag misschien heb je een idee. We hebben een externe applicatie die alle mails opslaat in de map concepten. als ik de macro uitvoer, hebben we het probleem dat alleen de eerste e-mail in de lijst correct wordt verzonden, alle andere e-mails worden uitgesteld omdat er aanhalingstekens '' aan het e-mailadres worden toegevoegd. Is er een manier om dit te vermijden?
Deze opmerking is gemaakt door de moderator op de site
Deze code verzendt alle concepten in een submap met de naam Merge Tools (hij wordt gevraagd voor verzending). Ik weet zeker dat jullie het kunnen bewerken om aan je behoeften te voldoen. Het is veel eenvoudiger. Genieten van :)
Sub SendAllMergeToolsConcepten()

If MsgBox("Weet u zeker dat u ALLE items in de conceptmap van uw Merge Tools-concept wilt verzenden?", _
vbVraag + vbJaNee) <> vbJa Dan Sub afsluiten

Dim myNamespace As Outlook.NameSpace 'Wijzig weergave naar Inbox om inline-fouten te voorkomen
Stel myNamespace = Application.GetNamespace("MAPI") 'Wijzig weergave in Inbox om inline-fout te voorkomen
Stel Application.ActiveExplorer.CurrentFolder in = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Wijzig weergave in Inbox om inline-fout te voorkomen

Dim fldDraft als MAPIFolder, msg als Outlook.MailItem, intCount als geheel getal
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Stuurt alle concepten alleen in de Merge Tools-map
intCount = 0
Do While fldDraft.Items.count > 0
Stel msg = fldDraft.Items(1) in
bericht.Verzenden
intCount = intCount + 1
Ringleiding
Indien niet (bericht is niets) Stel dan bericht = niets in
Stel fldDraft = Niets in
MsgBox intCount & "berichten verzonden", vbInformation + vbOKOnly

End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo jongens. Ik dacht ik deel het. Hier is mijn code voor het verzenden van alle concepten:
Sub SendAllDrafts() 'Door jamesmalcolmwood@gmail.com

If MsgBox("Weet u zeker dat u ALLE items in uw conceptmap wilt verzenden?", _
vbVraag + vbJaNee) <> vbJa Dan Sub afsluiten

Dim myNamespace As Outlook.NameSpace 'Wijzig weergave naar Inbox om inline-fouten te voorkomen
Stel myNamespace = Application.GetNamespace("MAPI") 'Wijzig weergave in Inbox om inline-fout te voorkomen
Stel Application.ActiveExplorer.CurrentFolder in = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Wijzig weergave in Inbox om inline-fout te voorkomen

Dim fldDraft als MAPIFolder, msg als Outlook.MailItem, intCount als geheel getal
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Verzendt alle concepten in uw hoofdmap voor concepten. Voeg voor een submap .Folders("mapnaam") toe
intCount = 0
Do While fldDraft.Items.count > 0
Stel msg = fldDraft.Items(1) in
bericht.Verzenden
intCount = intCount + 1
Ringleiding
Indien niet (bericht is niets) Stel dan bericht = niets in
Stel fldDraft = Niets in
MsgBox intCount & "berichten verzonden", vbInformation + vbOKOnly

End Sub
Er zijn nog geen reacties geplaatst
Laat uw commentaar
Posten als gast
×
Beoordeel dit bericht:
0   Personages
Voorgestelde locaties

Volg ons

Copyright © 2009 - www.extendoffice.com. | Alle rechten voorbehouden. Aangedreven door ExtendOffice. | Sitemap
Microsoft en het Office-logo zijn handelsmerken of gedeponeerde handelsmerken van Microsoft Corporation in de Verenigde Staten en / of andere landen.
Beschermd door Sectigo SSL