Makro ile e-mail gönderme

[turgay25]

Merhaba ;

Excel üzerinde c sütununda bulunan e-mail adreslerine toplu mail göndermek için buton oluşturmak işlemi hakkında bilgi almak istiyorum.Konu hakkında yardımcı olursanız sevinirim.

 

[hamitcan]

http://www.excel.web.tr/f50/toplu-birden-fazla-ki-iye-mail-atma-mail-t107530.html

 

[turgay25]

Yardımınız için teşekkür ederim.Benim yapmak istediğim bir buton ekleyerek c3 ve c80 sütunları arasındaki adresleri outlook ta listelemek mail@mail.com;amail@amail.com seklinde.

 

[hamitcan]

Böyle deneyin.

Sub BirdenFazlaKisiyeMailAt()
Set OutApp = New Outlook.Application
For i = 2 To [g65536].End(3).Row
    Set NewMail = CreateItem(olMailItem)
        Posta = Cells(i, "g") & ";" & Posta
    Next
        With NewMail
            .to = Left(Posta, Len(Posta) - 1)
            .Subject = "deneme"
            .Body = "Sayın Yetkili Bu mail ekte görmüş olduğunuz mail bilgi için gönderilmiştir."
            .Display
            '.Send
         End With
    Set NewMail = Nothing
    Set OutApp = Nothing
MsgBox "Bitti."
End Sub

 

[turgay25]

Böyle deneyin.

Sub BirdenFazlaKisiyeMailAt()
Set OutApp = New Outlook.Application
For i = 2 To [g65536].End(3).Row
    Set NewMail = CreateItem(olMailItem)
        Posta = Cells(i, "g") & ";" & Posta
    Next
        With NewMail
            .to = Left(Posta, Len(Posta) - 1)
            .Subject = "deneme"
            .Body = "Sayın Yetkili Bu mail ekte görmüş olduğunuz mail bilgi için gönderilmiştir."
            .Display
            '.Send
         End With
    Set NewMail = Nothing
    Set OutApp = Nothing
MsgBox "Bitti."
End Sub

İlginiz için teşekkür ederim.Hocam bu konu denediğimde user-defined type not defined hatası veriyor.

 

[hamitcan]

"Microsoft Outlook XX.0 Object Library" referansını ekleyip, deneyin.

 

[turgay25]

Hocam çok teşekkür ederim sorunu söylediğiniz şekilde hallettim.Son olarak bir şey sormak istiyorum.

mail@mail.com;mail1@mail.com;E-mail

Şeklinde çıkıyor

For i = 2 To [c65536].End(3).Row
buradaki c65536 yı c4:c500 seklinde değiştirsemde e-mail yazısı kalıyor

 

[hamitcan]

Dosyanızı ekleyin bakalım.

 

[turgay25]

Dosya ektedir.Bir kaç sayfa oluşturdum hepsinde aynı işlem yapılacak sadece hücre aralıklarını değiştiricem.

 

[hamitcan]

Döngü başlangıcını arttırın.

For i = 4 To [c65536].End(3).Row

 

[turgay25]

Yardımlarınız için çok teşekkür ederim hocam sorunu sayenizde hallettim.İyi çalışmalar dilerim.

 

[turgay25]

Hamit hocam son bir sorum olucak sizide uğraştırıyorum hakkınızı helal edin.

Sub AskaleMailAt()
Set OutApp = New Outlook.Application
For i = 9 To [d65536].End(3).Row
    Set NewMail = CreateItem(olMailItem)
        Posta = Cells(i, "d") & ";" & Posta
    Next
        With NewMail
            .To = Left(Posta, Len(Posta) - 1)
            .Subject = ""
            .Body = ""
            .Display
            '.Send
         End With
    Set NewMail = Nothing
    Set OutApp = Nothing
End Sub

Şeklinde makro sorunsuz çalışıyor.Fakat For i = 9 To [d65].End(3).Row veya For i = 9 To [d9:d65].End(3).Row yapınca yada bitiş noktası seçince makro hata veriyor.Ben d sütunun tamamını değilde d9:d50 arasında bulunan mailleri almak istiyorum bu konudada yardımcı olursanız çok sevinirim.İyi çalışmalar.

 

[hamitcan]

O zaman döngüyü bu şekilde oluşturun.

For i = 9 To 50 yada 65

 

[turgay25]

Denedim hocam malesef yine hata verdi.
For i = 9 To [d18].End(3).Row
şeklinde yapınca
http://a1301.hizliresim.com/15/3/hlq7c.jpg
resimdeki hatayı veriyor
For i = 9 To d18.End(3).Row ve For i = 9 To 18.End(3).Row
şeklinde yapınca yine aynı hatayı veriyor

 

[hamitcan]

Ama benim dediğimi uygulamamışsınız.
Burada döngü 50'de biter.

For i = 9 To 50

 

[turgay25]

Çok teşekkür ederim hocam söylediğiniz şekilde makroyu düzenledim.

 

[ermanusta]

mail gönderme ile ilgili benimde bir sorunum var yeni başlık açtım ama cvp veren çıkmadı

makro hazır sadece ufak birşey eklemek istiyorum

aşşağıdaki gibi bir makrom var elimde

-bu şekilde başlayan

Dim firma
aa = [b2].End(2).Row
If aa = "" Then
Exit Sub
End If
For h = 2 To aa
firma = Range("b" & h)
.
.
.
.

Next h
Application.ScreenUpdating = True
Tarih = Now + TimeValue("00:0:08")
Application.OnTime Tarih, "gonder"
End Sub


bu şekilde son bulan.Bu makro her 8 saniyede bir çalışıyor ve işlevi satırda bulunan bilgileri mail atmak. ama her başladığında baştan alıyor ve hep aynı satır için çalışıyor

yapmak istediğim bu makro ilk çalıştığında 1. satır için işlem yapsın
sonra 3-4-5-6.....100 de son bulsun. ve son bulduktan sonra ilk 100 satırı silsin istiyorum

bunu nasıl yapabilirim. isteyen olursa örnek dosyayıda ekleyebilirim makronun tamamınıda ekleyebilirim..

 

[hamitcan]

Soru, aşağıdaki linkte devam ediyor.
http://www.excel.web.tr/f48/macroyu-her-seferinde-bir-alt-satyr-icin-caly-t123925.html

 

[gokhan83]

Herkese merhaba;
Siteyi araştırdım ancak cevabını bulamadım. İşin uzmanlarından yardımcı olmasını rica edeceğim. F hücresinde doğum günleri bulunmaktadır. Ekteki makro tarih aynı olması halinde mail gönderiyor. Ancak doğum günü tarihlerinde mail atması için nasıl bir düzeltme yapmam gerekiyor?


Sub dgunuEmail()
Dim OutApp As Outlook.Application

Dim NewMail As Outlook.MailItem

Dim noE As Integer, i As Integer

noE = Cells(65536, 6).End(xlUp).Row

For i = 1 To noE

If Cells(i, 6) = Date Then


Set OutApp = New Outlook.Application

Set NewMail = CreateItem(olMailItem)

With NewMail

.To = Cells(i, 3).Text

.Subject = "Doğum Gününüz Kutlu Olsun!"

.Body = "Doğum gününüzü kutlar, bir ömür sağlıklı mutlu yıllar dileriz."

.Save

.Send

End With

Set NewMail = Nothing

Set OutApp = Nothing

End If

Next

End Sub

 

[hamitcan]

Dosya açıldığında otomatik göndersin mi istiyorsunuz yoksa kod bu işi yapıyor zaten.