Outlook'ta aynı anda birden çok taslak nasıl gönderilir?
Taslaklar klasörünüzde birden fazla taslak mesaj varsa ve şimdi, bunları tek tek göndermeden tek seferde göndermek istiyorsunuz. Outlook'ta bu işle nasıl hızlı ve kolay bir şekilde başa çıkabilirsiniz?
Outlook'ta tüm taslak iletileri tek seferde VBA kodu ile gönderin
Outlook'ta tüm taslak iletileri tek seferde VBA kodu ile gönderin
Aşağıdaki VBA kodları, Taslaklar klasöründeki tüm veya seçilen taslak e-postaları tek seferde göndermenize yardımcı olabilir, lütfen şu şekilde yapın:
1. Basılı tutun ALT + F11 tuşlarını açmak için Uygulamalar için Microsoft Visual Basic pencere.
2. Sonra tıklayın Ekle > modül, aşağıdaki kodu kopyalayıp açılan boş modüle yapıştırın, ekran görüntüsüne bakın:
VBA kodu: Outlook'ta tüm taslak e-postaları bir defada gönderin:
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. Ardından kodu kaydedin ve F5 Bu kodu çalıştırmak için tuşuna basın, tüm taslakları gönderip göndermediğinizi size hatırlatmak için bir istem kutusu açılır, Evet, ekran görüntüsüne bakın:
4. Ve kaç tane taslak e-postanın gönderildiğini size hatırlatmak için bir iletişim kutusu açılacaktır, ekran görüntüsüne bakın:
5. Ve sonra tıklayın OK düğmesi, içindeki tüm e-postalar Taslaklar klasör bir kerede gönderilecek, ekran görüntüsüne bakın:
Notlar:
1. Yukarıdaki kod, Outlook'unuzdaki tüm hesaplardan tüm taslak e-postaları gönderecektir.
2. Taslaklar klasöründen yalnızca belirli e-postalar göndermek istiyorsanız, lütfen aşağıdaki VBA kodunu uygulayın:
VBA kodu: Seçili e-postaları Taslaklar klasöründen gönderin:
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
İlgili Makaleler:
Outlook'ta Bireysel Olarak Birden Fazla Alıcıya E-posta Nasıl Gönderilir?
Outlook Üzerinden Excel'den Bir Listeye Kişiselleştirilmiş Toplu E-postalar Nasıl Gönderilir?
Outlook'ta Bireysel Olarak Birden Fazla Alıcıya Bir Takvim Nasıl Gönderilir?
Outlook'ta Bilmeden Birden Çok Alıcıya Nasıl E-posta Gönderilir?
Outlook için Kutools - Outlook'a 100 Gelişmiş Özellik Getirir ve Çalışmayı Çok Daha Kolay Hale Getirir!
- Otomatik CC / BCC e-posta gönderirken kurallara göre; Otomatik İleri Özel olarak birden çok E-posta; Otomatik cevap değişim sunucusu olmadan ve daha fazla otomatik özellik ...
- BCC Uyarısı - tümünü yanıtlamaya çalıştığınızda mesaj göster posta adresiniz BCC listesindeyse; Eksik Olduğunda Hatırlatve daha fazlası özellikleri hatırlat ...
- Posta görüşmesindeki Tüm Eklerle Yanıtla (Tümü); Birçok E-postayı Yanıtla saniyeler içinde; Otomatik Karşılama Ekleme cevap verdiğinde; Konuya Tarih Ekle ...
- Ek Araçları: Tüm Postalardaki Tüm Ekleri Yönetin, Otomatik Ayır, Tümünü Sıkıştır, Tümünü Yeniden Adlandır, Tümünü Kaydet ... Hızlı Rapor, Seçili Postaları Say...
- Güçlü Önemsiz E-postalar özel olarak; Yinelenen Postaları ve Kişileri Kaldır... Outlook'ta daha akıllı, daha hızlı ve daha iyi yapmanızı sağlar.
