Makro ile mail gönderme hakkinda

[byvolkan]

Iyi günler asagida gondermis oldugum kodlarda J sütünundaki siralamaya göre A sütünundaki degerleri e mail olarak gonderiyorum. Fakat benim sorunum J sutununda tarihi gelen her bir deger için tek tek mail atmasi. Ornek olarak bugun 12 veri girisinin tarihi geldiyse 12 mail birden gonderiyor. Bunlarin hepsini tek bir mail ile göndermesini istiyorum.
Kodalar asagidadir Yardimlariniz için simdiden tesekkur ederim.

Sub envoimail()

Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim delai As Integer

Set messagerie = CreateObject("Outlook.Application")

delai = 15 'jours

For Each cel In Range(" A4:A" & Range("A4").End(xlDown).Row)
    If cel.Offset(, 9).Value - Now < delai Then

        Set email = messagerie.CreateItem(0)

        With email
            .To = "xxxxx@xxx.com"
            .Subject = "Rappel l'etalonag"
            .Body = "Bonjour," & vbCrLf & "L'etalonage N° du moyenne : " & cel.Offset(, 0) & " arrive à échéance." & vbCrLf & "Merci de faire le nécessaire avant la date d’echeance." & vbCrLf & "Cordialement"

            .ReadReceiptRequested = False
            .Send ' à remplacer par .send si ok
        End With

        Set email = Nothing

    End If
Next cel

Set messagerie = Nothing

End Sub

 

[Ömer]

Merhaba,

Deneyiniz.

Sub envoimail()

Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim delai As Integer
Dim deger As String

Set messagerie = CreateObject("Outlook.Application")

delai = 15 'jours

For Each cel In Range(" A4:A" & Range("A4").End(xlDown).Row)
    If cel.Offset(, 9).Value - Now < delai Then

        deger = deger & vbLf & cel.Offset(, 0)

    End If
Next cel

Set email = messagerie.CreateItem(0)

With email
    .To = "xxxxx@xxx.com"
    .Subject = "Rappel l'etalonag"
    .Body = "Bonjour," & vbCrLf & "L'etalonage N° du moyenne : " & deger & vbLf & " arrive à échéance." & vbCrLf & "Merci de faire le nécessaire avant la date d’echeance." & vbCrLf & "Cordialement"

    .ReadReceiptRequested = False
    .Send ' à remplacer par .send si ok
End With

Set email = Nothing

Set messagerie = Nothing

End Sub

 

[byvolkan]

Merhabe
Öncelikle çok tesekkurler.
Maro su satirda hata verdi :

If cel.Offset(, 9).Value - Now < delai Then

 

[Ömer]

Daha önce vermiyor muydu? Ben bu satırla ilgili değişiklik yapmadım. Sadece maili döngü dışına attım.
Hata veren basit bir örnek dosya ekleyip açıklayınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

 

[byvolkan]

Tekrar tesekkurler
Buyrun dosyayi yukledim. Bu hatayi daha once almiyordum. Sanirim benim listemde bir sorun var ilk 30 satirdan sonrasini silip denedigimde makronuz calisiyor ama tum liste keldiginda malesef calismiyor.

İndir ornek

Dosyayı indir ornek

dosya.co

 

[Ömer]

Formül olan boş hücrelerden dolayı hata almışsınız. Aşağıdaki gibi deneyiniz.
Mail kısmı özel olabilir diye "xxxx@xxxx.com" olarak yazdım. Siz kendinize göre değiştirirsiniz.

Sub envoimail()

Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim delai As Integer
Dim deger As String

Set messagerie = CreateObject("Outlook.Application")

delai = 15 'jours

For Each cel In Range(" A4:A" & Range("A4").End(xlDown).Row)
    If cel.Offset(, 9).Value <> "" Then
        If cel.Offset(, 9).Value - Now < delai Then
   
            deger = deger & vbLf & cel.Offset(, 0)
   
        End If
    End If
Next cel

Set email = messagerie.CreateItem(0)

With email
    .To = "xxxx@xxxx.com"
    .Subject = "Rappel l'etalonag"
    .Body = "Bonjour," & vbCrLf & "L'etalonage N° du moyenne : " & deger & vbLf & " arrive à échéance." & vbCrLf & "Merci de faire le nécessaire avant la date d’echeance." & vbCrLf & "Cordialement"

    .ReadReceiptRequested = False
    .Send ' à remplacer par .send si ok
End With

Set email = Nothing

Set messagerie = Nothing

End Sub

 

[byvolkan]

Ömer çok tesekkurler
Mûkemmel bir sekilde çalisti.
Elinize saglik.

 

[byvolkan]

Formül olan boş hücrelerden dolayı hata almışsınız. Aşağıdaki gibi deneyiniz.
Mail kısmı özel olabilir diye "xxxx@xxxx.com" olarak yazdım. Siz kendinize göre değiştirirsiniz.

Sub envoimail()

Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim delai As Integer
Dim deger As String

Set messagerie = CreateObject("Outlook.Application")

delai = 15 'jours

For Each cel In Range(" A4:A" & Range("A4").End(xlDown).Row)
    If cel.Offset(, 9).Value <> "" Then
        If cel.Offset(, 9).Value - Now < delai Then
  
            deger = deger & vbLf & cel.Offset(, 0)
  
        End If
    End If
Next cel

Set email = messagerie.CreateItem(0)

With email
    .To = "xxxx@xxxx.com"
    .Subject = "Rappel l'etalonag"
    .Body = "Bonjour," & vbCrLf & "L'etalonage N° du moyenne : " & deger & vbLf & " arrive à échéance." & vbCrLf & "Merci de faire le nécessaire avant la date d’echeance." & vbCrLf & "Cordialement"

    .ReadReceiptRequested = False
    .Send ' à remplacer par .send si ok
End With

Set email = Nothing

Set messagerie = Nothing

End Sub

Ömer bey
Zamanla söyle bir sorunum oldu. Butun guncellenecek urunler bittikten sonra yinede bos bir sekilde mail atiyor.
Biz bu kodlara eger guncellenecek urun bulunmazsa mail gondermeyi iptal edecek bir eklenti yapabilirmiyiz?
Tesekkurler

 

[Ömer]

Set email = messagerie.CreateItem(0)

satırından önce aşağıdaki satırları ekleyip deneyiniz.

If deger = "" Then
    Set messagerie = Nothing
    Exit Sub
End If

 

[byvolkan]

Set email = messagerie.CreateItem(0)

satırından önce aşağıdaki satırları ekleyip deneyiniz.

If deger = "" Then
    Set messagerie = Nothing
    Exit Sub
End If

Ömer bey
Harika sekilde çalisti. Tekrar çok tesekkurler