Makro çalıştıktan 1 saat sonra Duruyor! Resimli hata gösterimi

[ermanusta]

Merhaba,

Elimde belli saniyede bir mail gönderen bir makro var, çalışmasında bir sorun yok ancak makroyu ne zaman çalıştırırsam çalıştırayım tam bir saat sonra resimdeki hatayı veriyor.

Hata resimlerini ekledim 2 adet
Birde makroyu ekledim

Makro Bu

Sub sendEmail()
Dim myOutlook As Outlook.Application, myEmail(100) As Outlook.MailItem, myEmailBody As String, r1 As Variant
Set myOutlook = GetObject(, "Outlook.Application")
If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


r1 = Sheets("html").Range("A1:A2222")

For i = 1 To UBound(r1)
myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
Next

For i = 1 To 500
If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
Set myEmail(i) = myOutlook.CreateItem(olMailItem)
myEmail(i).Importance = olImportanceNormal
myEmail(i).Subject = Sheets("mail adresleri").Cells(1, 2)
myEmail(i).BodyFormat = olFormatHTML
myEmail(i).HTMLBody = myEmailBody
myEmail(i).Recipients.Add Sheets("mail adresleri").Cells(1, 1)
myEmail(i).Send
Sheets("mail adresleri").Rows(1).Delete
ThisWorkbook.Save
Application.Wait (Now + TimeValue("0:00:37"))
Next



End Sub


Hata Kodu:

Hata İçeriği:

 

[Muzaffer Ali]

Günlük e-Posta gönderme adeti yapmış olduğunuz uygulama gibi programların kullanımını kısıtlamak için sınırlıdır. Bildiğim kadarıyla gmail ile bir günde 500 den fazala e-posta gönderemezsiniz.
Hatayı da mutemelen sınırı aştığınız için alıyosunuz.

 

[ermanusta]

Günlük e-Posta gönderme adeti yapmış olduğunuz uygulama gibi programların kullanımını kısıtlamak için sınırlıdır. Bildiğim kadarıyla gmail ile bir günde 500 den fazala e-posta gönderemezsiniz.
Hatayı da mutemelen sınırı aştığınız için alıyosunuz.

gmail üzerinden değil kendi web sitemin sunucusu üzerinden gönderiyorum ve miktar kısıtlaması yok, tek sorun 37 saniyede bir gönderebiliyor olmam bunu haricinde istediğim kadar mail gönderebiliyorum.
Hatanın buradan gelmesi imkansız.

 

[Muzaffer Ali]

Aşağıdaki kodları dener misiniz?

Sub sendEmail()
 Dim myOutlook As Outlook.Application
 Dim myEmail As Outlook.MailItem
 Dim myEmailBody As String
 Dim r1 As Variant
 
 Set myOutlook = New Outlook.Application
 If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


 r1 = Sheets("html").Range("A1:A2222")

 For i = 1 To UBound(r1)
 myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
 Next

 For i = 1 To 500
 If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
 Set myEmail = myOutlook.CreateItem(olMailItem)
 myEmail.Importance = olImportanceNormal
 myEmail.Subject = Sheets("mail adresleri").Cells(1, 2)
 myEmail.BodyFormat = olFormatHTML
 myEmail.HTMLBody = myEmailBody
 myEmail.Recipients.Add Sheets("mail adresleri").Cells(1, 1)
 myEmail.Send
 Sheets("mail adresleri").Rows(1).Delete
 ThisWorkbook.Save
 Application.Wait (Now + TimeValue("0:00:37"))
 Next
 End Sub

 

[ermanusta]

Aşağıdaki kodları dener misiniz?

Sub sendEmail()
 Dim myOutlook As Outlook.Application
 Dim myEmail As Outlook.MailItem
 Dim myEmailBody As String
 Dim r1 As Variant
 
 Set myOutlook = New Outlook.Application
 If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


 r1 = Sheets("html").Range("A1:A2222")

 For i = 1 To UBound(r1)
 myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
 Next

 For i = 1 To 500
 If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
 Set myEmail = myOutlook.CreateItem(olMailItem)
 myEmail.Importance = olImportanceNormal
 myEmail.Subject = Sheets("mail adresleri").Cells(1, 2)
 myEmail.BodyFormat = olFormatHTML
 myEmail.HTMLBody = myEmailBody
 myEmail.Recipients.Add Sheets("mail adresleri").Cells(1, 1)
 myEmail.Send
 Sheets("mail adresleri").Rows(1).Delete
 ThisWorkbook.Save
 Application.Wait (Now + TimeValue("0:00:37"))
 Next
 End Sub

peki bu şekilde deniyorum ama sonucu 1 saat sonra alabilicez

 

[Muzaffer Ali]

peki bu şekilde deniyorum ama sonucu 1 saat sonra alabilicez

Hata birşeyin alabileceği değerden daha fazla verilmeye çalışıldığı için çıkıyo.

myEmail değişkenini dizi olarak tanımlamışsınız. Kodlara bakınca buna gerek olmadığını gördüm. 100 tane e-posta sürekli hafızada kalarak çok fazala bellek harcıyor. belkide hata buradan kaynaklanıyodur.

kolay gelsin

 

[ermanusta]

Hata birşeyin alabileceği değerden daha fazla verilmeye çalışıldığı için çıkıyo.

myEmail değişkenini dizi olarak tanımlamışsınız. Kodlara bakınca buna gerek olmadığını gördüm. 100 tane e-posta sürekli hafızada kalarak çok fazala bellek harcıyor. belkide hata buradan kaynaklanıyodur.

kolay gelsin

Teşekkür ederim, düzelttiğiniz kod ile sorun kalmadı gayet güzel çalışıyor. elinize sağlık.

Bir fikrinizi almak istiyorum. bu şekilde mail gönderirken bazen outlookda gönder alma hatası alıyorum sanırım net kopuyor ve bu sırada mailler outlook da birikiyor, daha sonra bağlantı düzeldiğinde biriken 100 lerce maili birden atmaya çalışıyor ve outlook bu sefer komple kitleniyor.
acaba excellden mail gönderirken outlook da gönderilen bir mail olup olmadığı kontrol edilebilir mi, eğer giden kutusunda birşekilde bekleyen bir gönderi var ise yine belirtilen süre kadar bekleyebilir mi acaba?
bir yolu varsa yada ihtimal bile varsa bilmek isterim

 

[Muzaffer Ali]

Hiç Outlook kullanmadım sorunuzun yanıtını bilmiyorum. Ama internet bağlantısının olup olmadığını kontrol etmek isterseniz forumda bununla ilgili bir konu burada var.

 

[Zeki Gürsoy]

Değişken tanımında "myemail(100)" 100 elemanlı tanımlanmış. For döngüsünde 101. yi istediğinde bu hata iletisini alırsınız.

 

[mancubus]

her döngüde;
- 1 satır silmek,
- 37 saniye beklemek
- dosyayı kaydetmek
neden?

Sub sendEmail()

    Dim myOutlook As Outlook.Application
    Dim myEmail As Outlook.MailItem
    Dim myEmailBody As String
    Dim LR As Long
    
    Set myOutlook = New Outlook.Application
    
    With Sheets("html")
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            myEmailBody = myEmailBody & .Cells(i, 1) & vbCrLf
        Next
    End With
    
    LR = Sheets("mail adresleri").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To [B][COLOR="Red"]LR[/COLOR][/B]
        If Sheets("mail adresleri").Cells([B][COLOR="Red"]i[/COLOR][/B], 1) <> "" Then
            Set myEmail = myOutlook.CreateItem(olMailItem)
            With myEmail
                .Importance = olImportanceNormal
                .Subject = Sheets("mail adresleri").Cells([B][COLOR="Red"]i[/COLOR][/B], 2)
                .BodyFormat = olFormatHTML
                .HTMLBody = myEmailBody
                .Recipients.Add Sheets("mail adresleri").Cells([B][COLOR="Red"]i[/COLOR][/B], 1)
                .Send
            End With
        End If
    Next

    ThisWorkbook.Save

End Sub

satırları silmek isteniyorsa en sona Sheets("mail adresleri").Rows("1:" & LR).EntireRow.Delete şeklinde bir ilave yapılabilir.