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.
