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

Hvordan sendes flere kladder på én gang i Outlook?

Hvis der er flere kladdemeddelelser i mappen Kladder, og nu, vil du sende dem med det samme uden at sende en efter en. Hvordan kunne du håndtere dette job hurtigt og nemt i Outlook?

Send alle kladdemeddelelser på én gang i Outlook med VBA-kode


Send alle kladdemeddelelser på én gang i Outlook med VBA-kode

Følgende VBA-koder kan hjælpe dig med at sende alle eller udvalgte kladde-e-mails fra mappen Kladder på én gang. Gør som dette:

1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. Klik derefter på indsatte > Moduler, kopier og indsæt nedenstående kode i det åbnede blanke modul, se skærmbillede:

VBA-kode: Send alle kladde-e-mails på én gang i 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. Gem derefter koden, og tryk på F5 nøgle til at køre denne kode, vises et promptfelt for at minde dig, hvis du sender alle kladder, skal du klikke på Ja, se skærmbillede:

4. Og der vises en dialogboks for at minde dig om, hvor mange kladdemails der er sendt ud, se skærmbillede:

5. Og klik derefter på OK knappen, alle e-mails i Kladder mappen sendes med det samme, se skærmbillede:

Bemærkninger:

1. Ovenstående kode sender alle kladde-e-mails fra alle konti i din Outlook.

2. Hvis du bare vil sende nogle specifikke e-mails fra mappen Kladder, skal du anvende følgende VBA-kode:

VBA-kode: Send valgte e-mails fra mappen Kladder:

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

Relaterede artikler:

Sådan sender du en e-mail til flere modtagere individuelt i Outlook?

Sådan sendes personaliserede massemails til en liste fra Excel via Outlook?

Sådan sendes en kalender til flere modtagere individuelt i Outlook?

Sådan sender du e-mail til flere modtagere uden at vide dem i Outlook?


Kutools til Outlook - bringer 100 avancerede funktioner til Outlook, og gør arbejdet meget nemmere!

  • Auto CC / BCC ved regler, når du sender e-mail; Automatisk videresendelse Flere e-mails efter brugerdefineret; Auto svar uden udvekslingsserver og flere automatiske funktioner ...
  • BCC Advarsel - vis besked, når du prøver at besvare alle hvis din e-mail-adresse er på BCC-listen; Påmind, når du mangler vedhæftede filer, og mere minder funktioner ...
  • Svar (alle) med alle vedhæftede filer i mailsamtalen; Besvar mange e-mails på få sekunder Tilføj automatisk hilsen når svar Tilføj dato til emne ...
  • Vedhæftningsværktøjer: Administrer alle vedhæftede filer i alle mails, Automatisk afmontering, Komprimer alle, Omdøb alt, Gem alle ... Hurtig rapport, Tæl valgte mails...
  • Kraftige uønskede e-mails efter skik; Fjern duplikerede mails og kontakter... Gør dig i stand til at gøre smartere, hurtigere og bedre i Outlook.
shot kutools outlook kutools fane 1180x121
shot kutools outlook kutools plus fane 1180x121
 
Sorter kommentarer efter
Kommentarer (15)
Ingen vurderinger endnu. Vær den første til at bedømme!
Denne kommentar blev minimeret af moderatoren på webstedet
Genialt, virkede en charme, tak :)
Denne kommentar blev minimeret af moderatoren på webstedet
einfach nur perfekt. Herzlichen Dank
Denne kommentar blev minimeret af moderatoren på webstedet
Kopieret som ovenfor, men når jeg trykker på F5 sker der intet
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Cathleen,
Ovenstående kode fungerer fint i min Outlook, hvilken Outlook-version bruger du?
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har flere udvekslingskonti. Jeg vil gerne have en af ​​de konti, der ikke er min standard som afsender. Hvor skal jeg indsætte dette i koden? Tak!
Denne kommentar blev minimeret af moderatoren på webstedet
Er der nogen, der får nogle e-mails sendt til den slettede mappe, der gør dette?
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Bill,
Vil du sende flere udvalgte e-mails fra slettet foder?
Giv venligst dit problem mere detaljeret, tak!
Denne kommentar blev minimeret af moderatoren på webstedet
Hej skyyang, jeg står over for det samme problem. Jeg udarbejder normalt 15-20 e-mails og bruger derefter denne kode til at sende dem alle på én gang, men indser senere, at en af ​​disse e-mails ikke bliver sendt, snarere sendes de til min 'Slettet'-mappe. Selv prompten siger det korrekte antal e-mails for f.eks.: '20 e-mails sendt', men når jeg tjekker, ville der kun være blevet sendt 19, en jeg vil finde den liggende i mappen med slettede elementer. Jeg ønsker, at alle e-mails sendes til deres modtagere uden fejl. Kan du venligst fortælle mig hvorfor dette sker. Hjælp venligst.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, Darewin, Vi har opdateret ovenstående koder, prøv venligst igen, tak!
Denne kommentar blev minimeret af moderatoren på webstedet
Samme problem: hvis du vælger 4 beskeder, efter at have sendt tre af dem i papirkurven (på grund af "xDraftsItems.Item(i).Delete"-sætningen)
Denne kommentar blev minimeret af moderatoren på webstedet
Vi brugte scriptet til at sende alle udkast til e-mails på én gang for en batch af erklærings-e-mails genereret fra sage 200. E-mails i de sendte varer ser fine ud, men kunderne modtager dem med brødteksten på kinesisk! Nogle ideer til hvad der kan ske her?
Denne kommentar blev minimeret af moderatoren på webstedet
Kan du forklare, hvorfor den sidste mail (i = 1) er genskabt i en ny post i stedet for blot .Send?

Tak.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, hurtigt spørgsmål, måske har du en idé. Vi har en ekstern applikation, der gemmer alle mails i kladdemappen. hvis jeg kører makroen har vi det problem, at kun den første mail på listen bliver sendt korrekt, alle andre mails udskydes fordi den tilføjer anførselstegn ' ' til mailadressen. Er der en måde at undgå dette på?
Denne kommentar blev minimeret af moderatoren på webstedet
Denne kode sender alle kladder i en undermappe kaldet Merge Tools (den spørger dig før afsendelse). Jeg er sikker på, at I kan redigere det, så det passer til jeres behov. Det er langt enklere. God fornøjelse :)
Sub SendAllMergeToolsDrafts()

Hvis MsgBox("Er du sikker på, at du vil sende ALLE elementerne i mappen Merge Tools-kladder?", _
vbSpørgsmål + vbYesNo) <> vbYes Afslut derefter Sub

Dim myNamespace As Outlook.NameSpace 'Skift visning til Indbakke for at undgå inline-fejl
Set myNamespace = Application.GetNamespace("MAPI") 'Skift visning til indbakke for at undgå inline-fejl
Indstil Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Skift visning til Indbakke for at undgå inline-fejl

Dim fldDraft As MAPIfolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Sender kun alle kladder i mappen Merge Tools
intCount = 0
Gør mens fldDraft.Items.count > 0
Indstil msg = fldDraft.Items(1)
besked. Send
intCount = intCount + 1
Loop
Hvis ikke (msg Is Nothing) Indstil msg = Nothing
Indstil fldDraft = Intet
MsgBox intCount & "beskeder sendt", vbInformation + vbOKOnly

End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Hej gutter. tænkte jeg ville dele. Her er min kode til at sende alle kladder:
Sub SendAllDrafts() 'Af jamesmalcolmwood@gmail.com

Hvis MsgBox("Er du sikker på, at du vil sende ALLE elementerne i din kladdemappe?", _
vbSpørgsmål + vbYesNo) <> vbYes Afslut derefter Sub

Dim myNamespace As Outlook.NameSpace 'Skift visning til Indbakke for at undgå inline-fejl
Set myNamespace = Application.GetNamespace("MAPI") 'Skift visning til indbakke for at undgå inline-fejl
Indstil Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Skift visning til Indbakke for at undgå inline-fejl

Dim fldDraft As MAPIfolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Sender alle kladder i din hovedmappe med udkast. For en undermappe skal du tilføje .Folders("mappenavn")
intCount = 0
Gør mens fldDraft.Items.count > 0
Indstil msg = fldDraft.Items(1)
besked. Send
intCount = intCount + 1
Loop
Hvis ikke (msg Is Nothing) Indstil msg = Nothing
Indstil fldDraft = Intet
MsgBox intCount & "beskeder sendt", vbInformation + vbOKOnly

End Sub
Der er endnu ingen kommentarer her
Efterlad dine kommentarer
Sender som gæst
×
Bedøm dette indlæg:
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL