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.
