Outlook'ta birden fazla taslak nasıl aynı anda gönderilir?

Author: Xiaoyang Last Modified: 2025-08-07

Taslaklar klasörünüzde birden fazla taslak mesaj varsa ve şimdi bunları tek tek göndermek yerine hepsini bir defada göndermek istiyorsanız. Bu işlemi Outlook'ta hızlı ve kolay bir şekilde nasıl halledebilirsiniz?

VBA kodu ile Outlook'ta tüm taslak mesajları bir defada gönderin

VBA kodu ile Outlook'ta tüm taslak mesajları bir defada gönderin

Aşağıdaki VBA kodları, Taslaklar klasöründeki tüm veya seçilen taslak e-postalarını bir defada göndermenize yardımcı olabilir, lütfen şu adımları izleyin:

1. ALT + F11 tuşlarına basılı tutarak Microsoft Visual Basic for Applications penceresini açın.

2. Ardından Ekle > Modül'e tıklayın, 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ını 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

steps on sendig all draft messages at once in Outlook with VBA code

3. Ardından kodu kaydedin ve bu kodu çalıştırmak için F5 tuşuna basın, tüm taslakların gönderilip gönderilmeyeceği konusunda sizi uyarmak için bir uyarı kutusu açılacak, Evet'e tıklayın, ekran görüntüsüne bakın:

4. Gönderilen taslak e-posta sayısını hatırlatmak için bir diyalog kutusu açılacaktır, ekran görüntüsüne bakın:

5. Ardından Tamam düğmesine tıklayın, Taslaklar klasöründeki tüm e-postalar bir defada gönderilecektir, ekran görüntüsüne bakın:

Notlar:

1. Yukarıdaki kod, Outlook'unuzda bulunan tüm hesaplardaki tüm taslak e-postalarını gönderecektir.

2. Eğer Taslaklar klasöründen yalnızca belirli e-postalar göndermek istiyorsanız, lütfen aşağıdaki VBA kodunu uygulayın:

VBA kodu: Taslaklar klasöründen seçilen e-postaları 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

Outlook'daki AI Mail Asistanı: Daha Akıllı Yanıtlar, Daha Açık İletişim (tek tıklama sihirbazlığı!) ÜCRETSİZ

Kutools for Outlook'un AI Mail Asistanı ile günlük Outlook görevlerinizi kolaylaştırın. Bu güçlü araç, geçmiş e-postalarınızdan öğrenerek size akıllı ve doğru yanıtlar sunar, e-posta içeriğinizi optimize eder ve mesaj taslaklarını hazırlamada ve geliştirmede size yardımcı olur.

Bu özellik şunları destekler:

Akıllı Yanıtlar: Geçmiş konuşmalarınızdan oluşturulan, kişiselleştirilmiş, kesin ve kullanıma hazır yanıtlar alın.
Geliştirilmiş İçerik: E-posta metniniz otomatik olarak netlik ve etki için iyileştirilir.
Kolay Taslak Oluşturma: Sadece anahtar kelimeler sağlayın ve AI'nın gerisini halletmesine izin verin; birden fazla yazım stiliyle.
Akıllı Genişletmeler: Bağlam farkındalığına sahip önerilerle düşüncelerinizi genişletin.
Özetleme: Uzun e-postaların kısa ve öz bir özetini anında alın.
Küresel Kapsam: E-postalarınızı herhangi bir dile kolayca çevirin.

Bu özellik şunları destekler: