Excel ile mail ama Prosedür gereği sınırlı kişiye iletim

[askm]

Hayırlı geceler.
Excelde 500-600 kişilik bir liste mevcut. Bunlardan aralarda 20-30 kişi harici tümünün e-posta adresleri mevcut. Benim istediğim bunların tümüne veya süzme yaptığımda süzme yaptığım kısma e-posta göndermek. Yalnız işyeri prosedürü gereği 99 üzeri kişiye posta göndermiyor. Örneğin 300 kişiyi seçtiğimde ilk 99 kişiye gönderecek, sonra 2. 99 kişiye sonra 3. 99 kişiye sonrada kalan 3 kişiye mail gönderecek.
Birde Outlook da iki adet adres tanımlı. Bunlardan benim seçtiğim adresten mail göndermesini istiyorum. Yani a@hotmail.com seçersem giden kutusu o olacak, b seçersem de giden kutusu o olacak.
Son olarak da her zaman sabit mail gönderilmiyor. arada ekleri de oluyor. Bu ekleri de klaösrün yolunu gösterdiğimde klasör içerisindekileri ek olarak eklemesi gerekli.
Yardımcı olacaklara şimdiden teşekkürler.

 

[askm]

Sırası ile tek tek mail atmayı yapıyorum. Yalnız o zamanda giden posta kutusu doluyor. Posta limiti 1 gb olduğu için hemen doluyor ve tümünü silmem gerekiyor.

 

[askm]

Aşağıdaki gibi bir kod buldum, bunun üzerinde düzeltme yapmama yardımcı olabilir misiniz.
Birazını düzelttim ama tam değil.

Sub evnOutlookMail()
Dim evnout As Object
Dim evnmailitem As Object
resim = ThisWorkbook.Path & "\christmashappy-newyear.jpg"
For i = 2 To Range("a2").End(4).Row
Posta = Cells(i, "c") & ";" & Posta
Next i

say = say + 1
If say = 50 Then
Application.Wait Now + TimeSerial(0, 1, 0)
say = 0
End If


Set evnout = CreateObject("Outlook.Application")
Set evnmailitem = evnout.CreateItem(0)
With evnmailitem
.Subject = "Mutlu Yıllar - Happy New Year"
.To = Left(Posta, Len(Posta) - 1)
.Attachments.Add resim
isim = Cells(i, "a").Value & " " & Cells(i, "b").Value
.htmlBody = "<font name='Vivaldi' size='14'>Sevgili " & isim & "<br><br>" & _
"Yeni yılınızı kutlar,sağlık mutluluk ve başarılar dileriz.<br>" ' & _
"We wish you wery Christmas and happy new year. <br>" & _
"Wir wünschen Ihnen ein frohes Weihnachtsfest und einen guten Rufsch ins neue Jahr." & _
"Zalig Kerstmis Guliklig Nieuwjaar. Joyeur Noel et Bon Annee.</font>"
.Display ' Bu satırı silin. Kopmle silin, baştaki display ile birlikte...
'.send ' bu satırın başındaki tek tırnağı silin.
'Böylece ekrana almak yerine direkt yollamış olursunuz.
End With
Set evnmailitem = Nothing
Set evnout = Nothing

i = Empty: resim = vbNullString: isim = vbNullString
End Sub

 

[askm]

Giden kutusuna aralarda ";" konularak 99 kişiyi eklemesi ve göndermesini; sonra 100. den itibaren yine 99 kişiyi eklemesini istiyorum. Yukardaki kodlar ile tümünü ekliyor. 99 kişilik gruplara nasıl bölebilirim.

 

[Emir Hüseyin Çoban]

. . .

Yol gösterecektir...

Sub kod()

    For i = 2 To Cells(Rows.Count, "A").End(3).Row Step 10
        
        For a = 0 To 9
            If Cells(a + i, "A") <> "" Then
                m = m & Cells(a + i, "A") & ";"
            End If
        Next a
        
        kimlere = Left(m, Len(m) - 1)
        
[COLOR="DarkGreen"]        'mail gönderme kodlarınız
        '...
        ' .to = kimlere
        'kodlarınız[/COLOR]
        
        
        m = ""
    Next i
    
End Sub

. . .

 

[askm]

İlginiz için teşekkürler. Verdiğiniz kodlar ile aşağıdaki kodlar şeklinde düzelttim. Ancak
".Attachments.Add resim" kısmında hata verdiği için ikinci gruba geçmiyor.

Sub evnOutlookMail_1()
Dim evnout As Object
Dim evnmailitem As Object
resim = ThisWorkbook.Path & "\christmashappy-newyear.jpg"

For i = 2 To Range("a2").End(4).Row Step 99


For a = 0 To 98
If Cells(a + i, "c") <> "" Then
m = m & Cells(a + i, "C") & ";"
End If
Next a

kimlere = Left(m, Len(m) - 1)


Set evnout = CreateObject("Outlook.Application")
Set evnmailitem = evnout.CreateItem(0)
With evnmailitem
.Subject = "Mutlu Yıllar - Happy New Year"
.To = kimlere
.Attachments.Add resim
isim = Cells(i, "a").Value & " " & Cells(i, "b").Value

.htmlBody = "<font name='Vivaldi' size='14'>Sevgili " & isim & "<br><br>" & _
"Yeni yılınızı kutlar,sağlık mutluluk ve başarılar dileriz.<br> " & _
"We wish you wery Christmas and happy new year. <br>" & _
"Wir wünschen Ihnen ein frohes Weihnachtsfest und einen guten Rufsch ins neue Jahr." & _
"Zalig Kerstmis Guliklig Nieuwjaar. Joyeur Noel et Bon Annee. </font>"
'.Display ' Bu satırı silin. Kopmle silin, baştaki display ile birlikte...
.send ' bu satırın başındaki tek tırnağı silin.
'Böylece ekrana almak yerine direkt yollamış olursunuz.
End With



Set evnmailitem = Nothing
Set evnout = Nothing




i = Empty: resim = vbNullString: isim = vbNullString


m = ""
Next i


End Sub

 

[Emir Hüseyin Çoban]

. . .

Belirttiğim satırı End Sub dan öncesine alın.

......
m = ""
Next i
[COLOR="DarkRed"][B]i = Empty: resim = vbNullString: isim = vbNullString[/B][/COLOR]
End Sub

. . .

 

[askm]

Çok teşekkür ediyorum. Kullanmak isteyenlere tüm kodları gönderiyorum.

Yalnız ufak bir ricam daha olabilirse "Vivaldi" fontu aktif olmuyor. bunu da düzeltebilir miyim.
Teşekkürler.


Sub evnOutlookMail_1()
Dim evnout As Object
Dim evnmailitem As Object
resim = ThisWorkbook.Path & "\christmashappy-newyear.jpg"

For i = 2 To Range("a2").End(4).Row Step 99


For a = 0 To 98
If Cells(a + i, "c") <> "" Then
m = m & Cells(a + i, "C") & ";"
End If
Next a

kimlere = Left(m, Len(m) - 1)


Set evnout = CreateObject("Outlook.Application")
Set evnmailitem = evnout.CreateItem(0)
With evnmailitem
.Subject = "Mutlu Yıllar - Happy New Year"
.To = kimlere
.Attachments.Add resim
isim = Cells(i, "a").Value & " " & Cells(i, "b").Value

.htmlBody = "<font name='Vivaldi' size='14'>Sevgili " & isim & "<br><br>" & _
"Yeni yılınızı kutlar,sağlık mutluluk ve başarılar dileriz.<br> " & _
"We wish you wery Christmas and happy new year. <br>" & _
"Wir wünschen Ihnen ein frohes Weihnachtsfest und einen guten Rufsch ins neue Jahr." & _
"Zalig Kerstmis Guliklig Nieuwjaar. Joyeur Noel et Bon Annee. </font>"
'.Display ' Bu satırı silin. Kopmle silin, baştaki display ile birlikte...
.send ' bu satırın başındaki tek tırnağı silin.
'Böylece ekrana almak yerine direkt yollamış olursunuz.
End With





Set evnmailitem = Nothing
Set evnout = Nothing


m = ""
Next i


i = Empty: resim = vbNullString: isim = vbNullString


End Sub

 

[Emir Hüseyin Çoban]

. . .

<font[B] face='Vivaldi'[/B] size='14'>

. . .

 

[askm]

Çok teşekkür ederim. Allah razı olsun.