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

Hur skickar jag flera utkast samtidigt i Outlook?

Om det finns flera utkastmeddelanden i mappen Utkast och nu vill du skicka dem direkt utan att skicka en efter en. Hur kan du hantera det här jobbet snabbt och enkelt i Outlook?

Skicka alla utkastmeddelanden samtidigt i Outlook med VBA-kod


Skicka alla utkastmeddelanden samtidigt i Outlook med VBA-kod

Följande VBA-koder kan hjälpa dig att skicka alla eller valda utkast till e-post från mappen Utkast på en gång, gör så här:

1. Håll ner ALT + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

2. Klicka sedan Insert > Modulerna, kopiera och klistra in koden nedan i den öppnade tomma modulen, se skärmdump:

VBA-kod: Skicka alla utkast till e-post på en gång 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. Spara sedan koden och tryck på F5 för att köra den här koden, kommer en snabbruta att dyka upp för att påminna dig om att skicka alla utkast, klicka Ja, se skärmdump:

4. Och en dialogruta dyker upp för att påminna dig om hur många e-postutkast som har skickats ut, se skärmdump:

5. Och klicka sedan på OK -knappen, alla e-postmeddelanden i Utkast mappen skickas på en gång, se skärmdump:

Anmärkningar:

1. Ovanstående kod skickar alla utkast till e-post från alla konton i din Outlook.

2. Om du bara vill skicka specifika e-postmeddelanden från mappen Utkast, använd följande VBA-kod:

VBA-kod: Skicka valda e-postmeddelanden från mappen Utkast:

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

Relaterade artiklar:

Hur skickar du ett e-postmeddelande till flera mottagare individuellt i Outlook?

Hur skickar du personliga massmeddelanden till en lista från Excel via Outlook?

Hur skickar man en kalender till flera mottagare individuellt i Outlook?

Hur skickar du e-post till flera mottagare utan att de vet i Outlook?


Kutools for Outlook - ger 100 avancerade funktioner till Outlook och gör arbetet mycket enklare!

  • Auto CC / BCC enligt regler när du skickar e-post; Automatisk vidarebefordran Flera e-postmeddelanden efter anpassning; Auto-svar utan växelserver och mer automatiska funktioner ...
  • BCC-varning - visa meddelande när du försöker svara på alla om din e-postadress finns i BCC-listan; Påminn när du saknar bilagor, och mer påminna om funktioner ...
  • Svara (alla) med alla bilagor i e-postkonversationen; Svara många e-postmeddelanden inom sekunder; Lägg automatiskt till hälsning när svar Lägg till datum i ämnet ...
  • Bilagverktyg: Hantera alla bilagor i alla e-postmeddelanden, Auto Lossa, Komprimera alla, Byt namn på alla, Spara alla ... Snabbrapport, Räkna valda mejl...
  • Kraftfulla skräppost efter anpassning; Ta bort duplicerade e-postmeddelanden och kontakter... Gör det möjligt för dig att göra smartare, snabbare och bättre i Outlook.
shot kutools outlook kutools flik 1180x121
shot kutools outlook kutools plus flik 1180x121
 
Sortera kommentarer efter
Kommentarer (15)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
Strålande, fungerade en charm, tack :)
Denna kommentar minimerades av moderatoren på webbplatsen
einfach nur perfekt. Herzlichen Dank
Denna kommentar minimerades av moderatoren på webbplatsen
Kopierade enligt ovan men när jag trycker på F5 händer inget
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Cathleen,
Ovanstående kod fungerar bra i min Outlook, vilken Outlook-version använder du?
Denna kommentar minimerades av moderatoren på webbplatsen
Jag har flera utbyteskonton. Jag vill ha ett av kontona som inte är min standard som avsändare. Var ska jag infoga detta i koden? Tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Någon som får några e-postmeddelanden skickade till den borttagna mappen som gör detta?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Bill,
Vill du skicka flera valda e-postmeddelanden från raderade foder?
Ge ditt problem mer detaljerat, tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej skyyang, jag står inför samma problem. Jag skriver vanligtvis 15-20 e-postmeddelanden och använder sedan den här koden för att skicka dem alla på en gång, men inser senare att ett av dessa e-postmeddelanden inte skickas, utan de skickas till min "Deleted"-mapp. Till och med uppmaningen säger det korrekta antalet e-postmeddelanden för t.ex.: "20 e-postmeddelanden skickade", men när jag kontrollerar, skulle bara 19 ha skickats, en jag kommer att hitta den liggande i mappen med borttagna objekt. Jag vill att alla e-postmeddelanden ska skickas till sina mottagare utan fel. Kan du berätta för mig varför detta händer. Snälla hjälp.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, Darewin, Vi har uppdaterat ovanstående koder, försök igen, tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Samma problem: om du väljer 4 meddelanden, efter att ha skickat tre av dem i papperskorgen (på grund av "xDraftsItems.Item(i).Delete"-satsen)
Denna kommentar minimerades av moderatoren på webbplatsen
Vi använde skriptet för att skicka alla utkast till e-postmeddelanden på en gång för en grupp uttalanden som genererades från sage 200. E-postmeddelandena i de skickade objekten ser bra ut men kunderna tar emot dem med brödtexten på kinesiska! Några idéer om vad som kan hända här?
Denna kommentar minimerades av moderatoren på webbplatsen
Kan du förklara varför den sista posten (i = 1) återskapas i en ny post istället för bara .Send?

Tack.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, snabb fråga kanske du har en idé. Vi har en extern applikation som sparar alla mail till mappen utkast. om jag kör makrot har vi problemet att bara det första mailet i listan skickas korrekt, alla andra mail skjuts upp eftersom det lägger till citattecken ' ' till e-postadressen. Finns det något sätt att undvika detta?
Denna kommentar minimerades av moderatoren på webbplatsen
Denna kod skickar alla utkast i en undermapp som heter Merge Tools (den frågar dig innan du skickar). Jag är säker på att ni kan redigera den för att passa era behov. Det är mycket enklare. Njut av :)
Sub SendAllMergeToolsDrafts()

Om MsgBox("Är du säker på att du vill skicka ALLA objekt i mappen Merge Tools drafts?", _
vbQuestion + vbYesNo) <> vbYes Avsluta sedan Sub

Dim myNamespace As Outlook.NameSpace 'Ändra vy till Inbox för att undvika inline-fel
Set myNamespace = Application.GetNamespace("MAPI") 'Ändra vy till Inbox för att undvika inline-fel
Ställ in Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Ändra vy till Inbox för att undvika inline-fel

Dim fldDraft Som MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Sänder endast alla utkast i mappen Merge Tools
intCount = 0
Gör medan fldDraft.Items.count > 0
Set msg = fldDraft.Items(1)
msg.Skicka
intCount = intCount + 1
loop
Om inte (msg Is Nothing) Ställ in msg = Nothing
Ange fldDraft = Ingenting
MsgBox intCount & "meddelanden skickade", vbInformation + vbOKOnly

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Tjena. Tänkte dela med mig. Här är min kod för att skicka alla utkast:
Sub SendAllDrafts() 'Av jamesmalcolmwood@gmail.com

Om MsgBox("Är du säker på att du vill skicka ALLA objekt i din utkastmapp?", _
vbQuestion + vbYesNo) <> vbYes Avsluta sedan Sub

Dim myNamespace As Outlook.NameSpace 'Ändra vy till Inbox för att undvika inline-fel
Set myNamespace = Application.GetNamespace("MAPI") 'Ändra vy till Inbox för att undvika inline-fel
Ställ in Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Ändra vy till Inbox för att undvika inline-fel

Dim fldDraft Som MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Sänder alla utkast i din huvudmapp för utkast. För en undermapp, lägg till .Folders("mappnamn")
intCount = 0
Gör medan fldDraft.Items.count > 0
Set msg = fldDraft.Items(1)
msg.Skicka
intCount = intCount + 1
loop
Om inte (msg Is Nothing) Ställ in msg = Nothing
Ange fldDraft = Ingenting
MsgBox intCount & "meddelanden skickade", vbInformation + vbOKOnly

End Sub
Det finns inga kommentarer här ännu
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL