[Çözüldü]  Taslak Mail Gönderirken Zaman Aralığı Belirleme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Taslak Mail Gönderirken Zaman Aralığı Belirleme

İleti#1)  internetbeyi » 02 Eyl 2018 13:30

Merhaba,
Outlook ta taslak klasöründe bulunan mailleri göndermek için aşağıdaki Makro kodunu kullanıyorum.
Yapmak istediğim Taslak klasöründeki mailleri gönderirken belirli bir süre aralık vermesi.
Yani mailler arasında 5-10 saniye bekleme yaparak gönderim yapmak istiyorum.
Taslak kutumda bazen 1000 in üzerinde mail bulunabiliyor.


Aşağıdaki kodda değişiklik yaparak bu işlemi halledebilir miyim?
Yardımlarınız için şimdiden teşekürler.

Kod: Tümünü seç
Sub SendAllDraftEmails()

  Dim objDrafts As Outlook.Items
  Dim objDraft As Object
  Dim strPrompt As String
  Dim nResponse As Integer
  Dim i As Long
  Dim merror As Integer, Gcount As Integer

  On Error GoTo err_handle

  Set objDrafts = Outlook.Application.Session.GetDefaultFolder(olFolderDrafts).Items
  Gcount = objDrafts.Count

  If objDrafts.Count > o Then
      strPrompt = "Are you sure you want to send out all the drafts?"
      nResponse = MsgBox(strPrompt, vbQuestion + vbYesNo, "Confirm Sending")

      If nResponse = vbYes Then
            For i = objDrafts.Count To 1 Step -1
                  objDrafts.Item(i).Send
             Next
      End If

      If merror > 0 And merror = Gcount Then
             MsgBox "No Draft Emails Sent!", vbCritical, "Email Sending Errors!"
      ElseIf merror > 0 And merror < Gcount Then
             MsgBox "Some Draft Emails were sent - " & Trim(Str(merror)) & " emails were not sent", vbCritical, "Email Sending Errors!"
      Else
             MsgBox "All Draft Emails Sent!", vbInformation, "Email Sending"
      End If
  Else
      MsgBox "No Draft Emails Found!", vbExclamation, "No Draft Emails Found"
  End If

  Exit Sub

err_handle:

  If Err = "-2147467259" Then
      MsgBox "There must be at least one email address or contact group in the TO, CC or BCC fields" & vbCrLf & "Fix it and re-run your emails", vbExclamation, "Error in Email Address!"
      merror = 1 + merror
      Resume Next
  End If

End Sub
Kullanıcı avatarı
internetbeyi
Yeni Başlamış
 
Kayıt: 13 Ekm 2014 12:09
Meslek: Özel bir şirkette Bölüm Asistanı olarak çalışmaktayım.
Yaş: 31
İleti: 28
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: TEKİRDAĞ / ÇORLU

Cevap: Taslak Mail Gönderirken Zaman Aralığı Belirleme

İleti#2)  metehan8001 » 03 Eyl 2018 12:31

internetbeyi yazdı:objDrafts.Item(i).Send
             Next


Kodlarınızın arasındaki Next kodunun üstüne Application.Wait (Now + TimeValue("0:00:05")) kodunu yazınız.

İyi çalışmalar.
Kullanıcı avatarı
metehan8001
Siteye Alışmış
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 10:30
İleti: 393
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

Cevap: Taslak Mail Gönderirken Zaman Aralığı Belirleme

İleti#3)  internetbeyi » 03 Eyl 2018 21:23

Merhaba,

İlginiz için teşekkür ederim. Verdiğiniz kodu söylediğiniz yere ekledim ancak çalışmadı.
Kodu eklemeden önce makroyu çalıştırdığımda taslak kutusundaki tüm iletileri gönderiyordu.
Ekledikten sonra sadece 1 tane iletiyi gönderiyor ve duruyor.
Sanırım döngüyü sağlayamadı.

Konu günceldir, yardımcı olabilecek arkadaşlara şimdiden teşekkürler.
Kullanıcı avatarı
internetbeyi
Yeni Başlamış
 
Kayıt: 13 Ekm 2014 12:09
Meslek: Özel bir şirkette Bölüm Asistanı olarak çalışmaktayım.
Yaş: 31
İleti: 28
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: TEKİRDAĞ / ÇORLU

Cevap: Taslak Mail Gönderirken Zaman Aralığı Belirleme

İleti#4)  metehan8001 » 04 Eyl 2018 09:53

Hocam, bir de For i = objDrafts.Count To 1 Step -1 bu kodun altına yazıp deneyin. Ben döngülerde bunu kullanıyorum ve sağlıklı çalışıyor.
Kod: Tümünü seç
Application.Wait (Now + TimeValue("0:00:05"))
Kullanıcı avatarı
metehan8001
Siteye Alışmış
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 10:30
İleti: 393
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Taslak Mail Gönderirken Zaman Aralığı Belirleme

İleti#5)  internetbeyi » 09 Eyl 2018 00:10

Malesef,
Hiç tepki vermedi , hatta ilk maili dahi göndermedi.
Yinede ilginiz için teşekkür ederim.
Kullanıcı avatarı
internetbeyi
Yeni Başlamış
 
Kayıt: 13 Ekm 2014 12:09
Meslek: Özel bir şirkette Bölüm Asistanı olarak çalışmaktayım.
Yaş: 31
İleti: 28
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: TEKİRDAĞ / ÇORLU

Cevap: Taslak Mail Gönderirken Zaman Aralığı Belirleme

İleti#6)  Enes Recep BAĞ » 11 Eyl 2018 14:23

Kod: Tümünü seç
Sub SendAllDraftEmails()

  
Dim objDrafts As Outlook.Items
  Dim objDraft 
As Object
  Dim strPrompt 
As String
  Dim nResponse 
As Integer
  Dim i 
As Long
  Dim merror 
As IntegerGcount As Integer

  On Error 
GoTo err_handle

  Set objDrafts 
Outlook.Application.Session.GetDefaultFolder(olFolderDrafts).Items
  Gcount 
objDrafts.Count

  
If objDrafts.Count o Then
      strPrompt 
"Are you sure you want to send out all the drafts?"
      
nResponse MsgBox(strPromptvbQuestion vbYesNo"Confirm Sending")

      If 
nResponse vbYes Then
            
For objDrafts.Count To 1 Step -1
                  objDrafts
.Item(i).Send
                  Application
.Wait (Now TimeValue("0:00:05"))
             
Next
      End 
If

      If 
merror And merror Gcount Then
             MsgBox 
"No Draft Emails Sent!"vbCritical"Email Sending Errors!"
      
ElseIf merror And merror Gcount Then
             MsgBox 
"Some Draft Emails were sent - " Trim(Str(merror)) & " emails were not sent"vbCritical"Email Sending Errors!"
      
Else
             
MsgBox "All Draft Emails Sent!"vbInformation"Email Sending"
      
End If
  Else
      
MsgBox "No Draft Emails Found!"vbExclamation"No Draft Emails Found"
  
End If

  Exit 
Sub

err_handle
:

  If 
Err "-2147467259" Then
      MsgBox 
"There must be at least one email address or contact group in the TO, CC or BCC fields" vbCrLf "Fix it and re-run your emails"vbExclamation"Error in Email Address!"
      
merror merror
      Resume Next
  End 
If

End Sub
Kullanıcı avatarı
Enes Recep BAĞ
Forum Moderatörü
 
Adı Soyadı:Enes Recep BAĞ
Kayıt: 30 Ağu 2010 17:39
Konum: 0 549 808 82 66
Meslek: Bilgi işlem
Yaş: 36
İleti: 8238
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray / Merkez

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Taslak Mail Gönderirken Zaman Aralığı Belirleme

İleti#7)  internetbeyi » 11 Eyl 2018 21:59

Enes Bey ilginiz için teşekkür ederim. Verdiğiniz kodu direkt olarak (kopyala-yapıştır) uyguladığımda ilk maili gönderiyor ve daha sonra herhangi bir işlem yapmıyor.

Belki outlook sürümümden dolayı çalışmıyor olabilir.

Alternatif olarak ilk kodda bazı değişiklikler yaparak sonuca ulaştım sayılır. Outlookun bir süre donmuş gibi gözükmesine rağmen maillerin arasına eklediğim bekleme süresi işlevini görüyor.

Kod: Tümünü seç
[color=#FF0000]Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)[/color]

Sub SendAllDraftEmails()

  Dim objDrafts As Outlook.Items
  Dim objDraft As Object
  Dim strPrompt As String
  Dim nResponse As Integer
  Dim i As Long
  Dim merror As Integer, Gcount As Integer

  On Error GoTo err_handle

  Set objDrafts = Outlook.Application.Session.GetDefaultFolder(olFolderDrafts).Items
  Gcount = objDrafts.Count

  If objDrafts.Count > o Then
      strPrompt = "Are you sure you want to send out all the drafts?"
      nResponse = MsgBox(strPrompt, vbQuestion + vbYesNo, "Confirm Sending")

      If nResponse = vbYes Then
            For i = objDrafts.Count To 1 Step -1
                  objDrafts.Item(i).Send
             [color=#FF00FF]Sleep 10000[/color]
             Next
      End If

      If merror > 0 And merror = Gcount Then
             MsgBox "No Draft Emails Sent!", vbCritical, "Email Sending Errors!"
      ElseIf merror > 0 And merror < Gcount Then
             MsgBox "Some Draft Emails were sent - " & Trim(Str(merror)) & " emails were not sent", vbCritical, "Email Sending Errors!"
      Else
             MsgBox "All Draft Emails Sent!", vbInformation, "Email Sending"
      End If
  Else
      MsgBox "No Draft Emails Found!", vbExclamation, "No Draft Emails Found"
  End If

  Exit Sub

err_handle:

  If Err = "-2147467259" Then
      MsgBox "There must be at least one email address or contact group in the TO, CC or BCC fields" & vbCrLf & "Fix it and re-run your emails", vbExclamation, "Error in Email Address!"
      merror = 1 + merror
      Resume Next
  End If

End Sub


İlginiz için teşekkür ederim. --)(
Kullanıcı avatarı
internetbeyi
Yeni Başlamış
 
Kayıt: 13 Ekm 2014 12:09
Meslek: Özel bir şirkette Bölüm Asistanı olarak çalışmaktayım.
Yaş: 31
İleti: 28
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: TEKİRDAĞ / ÇORLU


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Google [Bot] ve 5 misafir

Bumerang - Yazarkafe