E-posta gönderim hatası

[BBBBuRaKKKK]

Merhabalar bu kodda 29 tane e posta satırı var. 29 satırdan biri boş olduğunda hata veriyor ve göndermiyor. Ben sadece dolu olan e-posta satırlarını göndermesini istiyorum. Yardımcı olur musunuz ?

Sub MailTekrar()

Set bg = Worksheets("BOLGE_KODU")

sıra = 2

While bg.Cells(sıra, 5) <> 0
sıra = sıra + 1
Wend

For s = 1 To 30
Eposta
sıra = sıra + 1
Next s


End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Sub Eposta()

Set bg = Worksheets("BOLGE_KODU")

Dim app As Object
Dim CurrFile As String

Set app = CreateObject("Outlook.Application")
Set posta = app.CreateItem(olMailItem)
For i = 1 To Cells.End(3).Row

sıra = 2
While bg.Cells(sıra, 5) <> 0
sıra = sıra + 1
Wend
adres = bg.Cells(sıra, 4)
sayac = 1


bolgead = bg.Cells(sıra, 3)
dosyayolu = bg.Cells(2, 7)
While bolge <> 0



Wend

With posta

.To = adres
.CC = bg.Cells(sıra, 6)
.BCC = ""
.Subject = bg.Cells(6, 7)
.HTMLBody = bg.Cells(12, 7)

.Attachments.Add dosyayolu & bolgead & ".xlsx"

.Display
.Send
bg.Cells(sıra, 5) = "Gönderildi"

sayac = sayac + 1
End With




End Sub

 

[ÖmerFaruk]

Kodları bu şekilde paylaştığınızda okunamıyor ve kodlar da düzensiz yazılmışsa anlaşılamıyor.

Altın üyesiniz. Gerçek olmayan verilerinizden oluşan bir örnek dosyayı paylaşıp sorununuzu ya da amacınız basitçe izah ederseniz çözüm gelecektir.

 

[AHMETDMR83]

sıra kısmında 2 den başlamış 1 den başlatırsanız 30 olur döngü zaten 30 adete kadar yapılmış

 

[BBBBuRaKKKK]

dosya ektedir

 

[ÖmerFaruk]

MailTekrar makronuzdaki karışık durumları sildim. Ne zaman çağırıp ne zaman çalıştırıyorsunuz bilemedim. Ancak Mail Tekrar makronuzu tetiklediğiniz an istediğiniz satırlardaki mail gönderimi gerçekleşecektir.

Sub MailTekrar()
    Call Eposta
End Sub

Sub Eposta()
Dim bg As Worksheet, i As Integer, konu As String, Gövde As String, Dosya As String, adres As String, durum As String, badres As String
Dim app As Object
Dim CurrFile As String

    Set bg = Worksheets("BOLGE")
    Set app = CreateObject("Outlook.Application")
    Set posta = app.CreateItem(olMailItem)
    
    konu = bg.Cells(6, 7)
    Gövde = bg.Cells(12, 7)
    Dosya = bg.Cells(2, 7) & bg.Cells(sıra, 3) & ".xlsx"

    For i = 2 To bg.Range("A" & Rows.Count).End(3).Row
        adres = bg.Cells(i, 4)
        durum = bg.Cells(i, 5)
        badres = bg.Cells(i, 6)
        If InStr(1, adres, "@") > 0 And durum <> "Gönderildi" Then
            With posta
              .To = adres
              .CC = badres
              .BCC = ""
              .Subject = bg.Cells(6, 7)
              .HTMLBody = bg.Cells(12, 7)
              .Attachments.Add dosyayolu & bolgead & ".xlsx"
              .Display 'kodlar doğru çalışıyorsa bu satırı silip alttaki satırı dediğim şekilde aktif edin.
              '.Send 'Kodlar doğru çalışıyorsa üstteki satırısilin ve bu satırın başındakini ' işaretini kaldırın
            End With
            bg.Cells(sıra, 5) = "Gönderildi"
        End If
    Next i
    Set posta = Nothing: Set app = Nothing: Set bg = Nothing
End Sub

 

[BBBBuRaKKKK]

Siz denediniz mi acaba bende hata veriyor. ilk e postayı gönderiyor hata veriyor sonra

 

[ÖmerFaruk]

Mail atmayı denemedim.
İlk mesajımda da dedğim gibi kodlarınız çok karışık. Ne niçin kazılmış belli değil. Garip garip döngüler var.
İkincisi dosyanızı test etmem için benim bir sürü uğraşmam gerek. Mail adresleri kuracam, ataç dosyaları oluşturacam vs.
Ayrıca imza bölümünde Excel verisyon ve Diliniz kısmında VBA yazıyor ki bunu düzeltmelisiniz.

Siz dosyanızı ve sorunuzu ne kadar çözüme uygun halde yollarsanız o kadar güzel cevaplar gelecektir.

 

[BBBBuRaKKKK]

VBA DA yeni sayılırım. Düzeltmeye çalışacağım. İlginiz için teşekkürler

 

[ÖmerFaruk]

Bu da denenmiş hali.
Denerken Atachment pasif ettim. Sizde dosyalar hazırdır zaten. Çalışacaktır.

Sub Eposta2()
Dim bg As Worksheet, i As Integer, konu As String, Gövde As String, Dosya As String, adres As String, durum As String, badres As String
Dim MailObj As Object, MailYeni As Object


    On Error Resume Next
    Set MailObj = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If MailObj Is Nothing Then Call Shell("Outlook.exe", vbHide)
    Set MailObj = CreateObject("Outlook.Application")
    Set bg = Worksheets("BOLGE")

    konu = bg.Cells(6, 7)
    Gövde = bg.Cells(12, 7)

    For i = 2 To 30
        adres = bg.Cells(i, 4)
        durum = bg.Cells(i, 5)
        badres = bg.Cells(i, 6)
        If InStr(1, adres, "@") > 0 And durum <> "Gönderildi" Then
        Dosya = bg.Cells(2, 7) & bg.Cells(i, 3) & ".xlsx"
        Set MailYeni = MailObj.CreateItem(0)
        With MailYeni
            .To = adres
            .CC = badres
            .BCC = ""
            .Subject = bg.Cells(6, 7)
            .HTMLBody = bg.Cells(12, 7)
            .Attachments.Add Dosya
            .BodyFormat = 2
            '.Display
            .Send
        End With
        Set MailYeni = Nothing
        bg.Cells(i, 5) = "Gönderildi"
        End If
    Next i
     Set MailObj = Nothing: Set bg = Nothing
End Sub

 

[BBBBuRaKKKK]

İstediğim tam olarak buydu. İlginize çok Teşekkür ederim