Πώς να στείλετε πολλά πρόχειρα ταυτόχρονα στο Outlook;
Εάν υπάρχουν πολλά πρόχειρα μηνύματα στο φάκελο Πρόχειρα και τώρα, θέλετε να τα στείλετε ταυτόχρονα χωρίς να στείλετε ένα προς ένα. Πώς θα μπορούσατε να αντιμετωπίσετε αυτήν την εργασία γρήγορα και εύκολα στο Outlook;
Αποστολή όλων των πρόχειρων μηνυμάτων ταυτόχρονα στο Outlook με κωδικό VBA
Αποστολή όλων των πρόχειρων μηνυμάτων ταυτόχρονα στο Outlook με κωδικό VBA
Οι ακόλουθοι κωδικοί VBA μπορούν να σας βοηθήσουν να στείλετε ταυτόχρονα όλα ή επιλεγμένα πρόχειρα μηνύματα ηλεκτρονικού ταχυδρομείου από το φάκελο Πρόχειρα, κάντε τα εξής:
1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.
2. Στη συνέχεια κάντε κλικ στο κουμπί Κύριο θέμα > Μονάδα μέτρησης, αντιγράψτε και επικολλήστε τον παρακάτω κώδικα στην ανοιχτή κενή ενότητα, δείτε το στιγμιότυπο οθόνης:
Κωδικός VBA: Αποστολή όλων των πρόχειρων μηνυμάτων ηλεκτρονικού ταχυδρομείου ταυτόχρονα στο 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. Στη συνέχεια, αποθηκεύστε τον κωδικό και πατήστε F5 για να εκτελέσετε αυτόν τον κωδικό, θα εμφανιστεί ένα πλαίσιο προτροπής για να σας υπενθυμίσει εάν στείλετε όλα τα πρόχειρα, κάντε κλικ Ναι, δείτε το στιγμιότυπο οθόνης:
4. Και θα εμφανιστεί ένα παράθυρο διαλόγου για να σας υπενθυμίσει πόσα πρόχειρα μηνύματα ηλεκτρονικού ταχυδρομείου έχουν σταλεί, δείτε το στιγμιότυπο οθόνης:
5. Και στη συνέχεια κάντε κλικ στο κουμπί OK κουμπί, όλα τα μηνύματα στο Πρόχειρα ο φάκελος θα σταλεί ταυτόχρονα, δείτε το στιγμιότυπο οθόνης:
:
1. Ο παραπάνω κώδικας θα στείλει όλα τα πρόχειρα μηνύματα ηλεκτρονικού ταχυδρομείου από όλους τους λογαριασμούς στο Outlook.
2. Εάν θέλετε απλώς να στείλετε συγκεκριμένα μηνύματα ηλεκτρονικού ταχυδρομείου από το φάκελο Πρόχειρα, εφαρμόστε τον ακόλουθο κώδικα VBA:
Κωδικός VBA: Αποστολή επιλεγμένων μηνυμάτων ηλεκτρονικού ταχυδρομείου από το φάκελο Πρόχειρα:
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
Σχετικά Άρθρα:
Πώς να στείλετε ένα email σε πολλούς παραλήπτες μεμονωμένα στο Outlook;
Πώς να στείλετε εξατομικευμένα ηλεκτρονικά μηνύματα σε λίστα από το Excel μέσω του Outlook;
Πώς να στείλετε ένα ημερολόγιο σε πολλούς παραλήπτες μεμονωμένα στο Outlook;
Πώς να στείλετε email σε πολλούς παραλήπτες χωρίς να το γνωρίζουν στο Outlook;
Τα καλύτερα εργαλεία παραγωγικότητας γραφείου
Kutools για το Outlook - Πάνω από 100 ισχυρές δυνατότητες για υπερφόρτιση του Outlook σας
🤖 Βοηθός αλληλογραφίας AI: Άμεσα επαγγελματικά email με μαγεία AI -- με ένα κλικ για ιδιοφυείς απαντήσεις, τέλειος τόνος, πολυγλωσσική γνώση. Μεταμορφώστε τα email χωρίς κόπο! ...
📧 Αυτοματοποίηση ηλεκτρονικού ταχυδρομείου: Εκτός γραφείου (Διαθέσιμο για POP και IMAP) / Προγραμματισμός αποστολής email / Αυτόματο CC/BCC βάσει κανόνων κατά την αποστολή email / Αυτόματη προώθηση (Σύνθετοι κανόνες) / Αυτόματη προσθήκη χαιρετισμού / Διαχωρίστε αυτόματα τα μηνύματα ηλεκτρονικού ταχυδρομείου πολλών παραληπτών σε μεμονωμένα μηνύματα ...
📨 Διαχείριση e-mail: Εύκολη ανάκληση email / Αποκλεισμός απάτης email από υποκείμενα και άλλους / Διαγραφή διπλότυπων μηνυμάτων ηλεκτρονικού ταχυδρομείου / Προχωρημένη Αναζήτηση / Ενοποίηση φακέλων ...
📁 Συνημμένα Pro: Μαζική αποθήκευση / Αποσύνδεση παρτίδας / Συμπίεση παρτίδας / Αυτόματη αποθήκευση / Αυτόματη απόσπαση / Αυτόματη συμπίεση ...
🌟 Διασύνδεση Magic: 😊Περισσότερα όμορφα και δροσερά emojis / Ενισχύστε την παραγωγικότητά σας στο Outlook με προβολές με καρτέλες / Ελαχιστοποιήστε το Outlook αντί να κλείσετε ...
???? Με ένα κλικ Wonders: Απάντηση σε όλους με εισερχόμενα συνημμένα / Email κατά του phishing / 🕘Εμφάνιση ζώνης ώρας αποστολέα ...
👩🏼🤝👩🏻 Επαφές & Ημερολόγιο: Μαζική προσθήκη επαφών από επιλεγμένα μηνύματα ηλεκτρονικού ταχυδρομείου / Διαχωρίστε μια ομάδα επαφής σε μεμονωμένες ομάδες / Κατάργηση υπενθυμίσεων γενεθλίων ...
Διανεμήθηκαν παραπάνω από 100 Χαρακτηριστικά Περιμένετε την εξερεύνηση σας! Κάντε κλικ εδώ για να ανακαλύψετε περισσότερα.
