Note: The other languages of the website are Google-translated. Back to English

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.
shot kutools görünüm kutools sekmesi 1180x121
shot kutools görünüm kutools artı sekme 1180x121
 
Yorumları sıralama ölçütü
Yorumlar (15)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Parlak, bir cazibe çalıştı, teşekkür ederim :)
Bu yorum sitedeki moderatör tarafından en aza indirildi
einfach nur mükemmel. Herzlichen Dank
Bu yorum sitedeki moderatör tarafından en aza indirildi
Yukarıdaki gibi kopyalandı ama F5'e bastığımda hiçbir şey olmuyor
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Cathleen,
Yukarıdaki kod Outlook'umda iyi çalışıyor, hangi Outlook sürümünü kullanıyorsunuz?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Birden fazla döviz hesabım var. Gönderen olarak varsayılan olmayan hesaplardan birine sahip olmak istiyorum. Bunu kodun neresine ekleyebilirim? Teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunu yaparak silinen klasöre gönderilen bazı e-postaları alan var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Selam Bill,
Silinen dosyadan birden çok seçili e-posta göndermek istiyor musunuz?
Lütfen sorununuzu daha detaylı anlatın, teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba skyyang, aynı problemle karşı karşıyayım. Genellikle 15-20 e-posta hazırlarım ve ardından hepsini bir kerede göndermek için bu kodu kullanırım, ancak daha sonra bu e-postalardan birinin gönderilmediğini, bunun yerine 'Silindi' klasörüme gönderildiğini fark ettim. Komut istemi bile, örneğin '20 e-posta gönderildi' için doğru sayıda e-posta olduğunu söylüyor, ancak kontrol ettiğimde, yalnızca 19'u gönderilmiş olacaktı, bir tanesinin silinmiş öğeler klasörümde yattığını bulacağım. Tüm e-postaların alıcılarına hatasız gönderilmesini istiyorum. Lütfen bana bunun neden olduğunu söyler misiniz? Lütfen yardım et.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Darewin,Yukarıdaki kodları güncelledik, lütfen tekrar deneyin, teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Aynı sorun: 4 mesaj seçerseniz, üç tanesini çöp klasörüne gönderdikten sonra ("xDraftsItems.Item(i.Delete" ifadesi nedeniyle)
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sage 200'den oluşturulan bir grup bildirim e-postası için tüm taslak e-postaları bir kerede göndermek için komut dosyasını kullandık. Gönderilen öğelerdeki e-postalar iyi görünüyor, ancak müşteriler bunları gövde metni Çince olarak alıyor! Burada neler olabileceğine dair bir fikriniz var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Son postanın (i = 1) neden sadece .Send yerine yeni bir MailItem'de yeniden oluşturulduğunu açıklayabilir misiniz?

Teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, hızlı soru belki bir fikriniz vardır. Tüm postaları taslaklar klasörüne kaydeden harici bir uygulamamız var. makroyu çalıştırırsam, listedeki sadece ilk mailin doğru bir şekilde gönderilmesi sorunuyla karşılaşıyoruz, diğer tüm mailler mail adresine tırnak işaretleri '' ' eklediğinden erteleniyor.Bunu önlemenin bir yolu var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kod, tüm taslakları Birleştirme Araçları adlı bir alt klasöre gönderir (göndermeden önce size sorar). Eminim siz de ihtiyaçlarınıza göre düzenleyebilirsiniz. Çok daha basit. Zevk almak :)
Sub SendAllMergeToolsDrafts()

If MsgBox("Birleştirme Araçları taslakları klasörünüzdeki TÜM öğeleri göndermek istediğinizden emin misiniz?", _
vbQuestion + vbYesNo) <> vbYes Sonra Sub Exit

MyNamespace As Outlook.NameSpace olarak karart 'Satır içi hatayı önlemek için görünümü Gelen Kutusu olarak değiştirin
Set myNamespace = Application.GetNamespace("MAPI") 'Satır içi hatayı önlemek için görünümü Gelen Kutusu olarak değiştirin
Application.ActiveExplorer.CurrentFolder = _ olarak ayarlayın
myNamespace.GetDefaultFolder(olFolderInbox) 'Satır içi hatayı önlemek için görünümü Gelen Kutusu olarak değiştirin

MAPIFolder Olarak Dim fldDraft, Outlook.MailItem Olarak msg, Tamsayı Olarak intCount
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Yalnızca Birleştirme Araçları klasöründeki tüm taslakları gönderir
intSayı = 0
fldDraft.Items.count > 0 iken yapın
msg ayarla = fldDraft.Items(1)
mesaj.Gönder
intCount = intCount + 1
döngü
Değilse (msj Hiçbir Şey Değilse) O zaman msg'yi ayarlayın = Hiçbir şey
fldDraft'ı ayarla = Hiçbir şey
MsgBox intCount & "gönderilen mesajlar", vbInformation + vbOKOnly

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba millet. paylaşayım dedim. İşte tüm taslakları göndermek için kodum:
Sub SendAllDrafts() 'Jamesmalcolmwood@gmail.com tarafından

Eğer MsgBox("Taslaklar klasörünüzdeki TÜM öğeleri göndermek istediğinizden emin misiniz?", _
vbQuestion + vbYesNo) <> vbYes Sonra Sub Exit

MyNamespace As Outlook.NameSpace olarak karart 'Satır içi hatayı önlemek için görünümü Gelen Kutusu olarak değiştirin
Set myNamespace = Application.GetNamespace("MAPI") 'Satır içi hatayı önlemek için görünümü Gelen Kutusu olarak değiştirin
Application.ActiveExplorer.CurrentFolder = _ olarak ayarlayın
myNamespace.GetDefaultFolder(olFolderInbox) 'Satır içi hatayı önlemek için görünümü Gelen Kutusu olarak değiştirin

MAPIFolder Olarak Dim fldDraft, Outlook.MailItem Olarak msg, Tamsayı Olarak intCount
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Ana taslaklar klasörünüzdeki tüm taslakları gönderir. Bir alt klasör için .Folders("klasör adı") ekleyin
intSayı = 0
fldDraft.Items.count > 0 iken yapın
msg ayarla = fldDraft.Items(1)
mesaj.Gönder
intCount = intCount + 1
döngü
Değilse (msj Hiçbir Şey Değilse) O zaman msg'yi ayarlayın = Hiçbir şey
fldDraft'ı ayarla = Hiçbir şey
MsgBox intCount & "gönderilen mesajlar", vbInformation + vbOKOnly

End Sub
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır