• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

otomatik mail gönderme

Ekteki dosyayı inceleyiniz.

Not: Deneme yaparken sizin adresinize de gönderim yaptım. Mailinizi kontrol ederseniz görebilirsiniz.

Korhan bey merhaba,

Çocuklar hastaydı hastane koşturma derken mailleri şimdi gördüm çok sevindim. Şuan mobildeyim yarın ilk işim dosyayı incelemek olacak çok çok tşk ederim.
 
Merhaba,

Öncelikle geçmiş olsun demek istiyorum. Umarım önemli bir rahatsızlık yoktur.

Dosyanın da işinize yaramasına sevindim. Güle güle kullanın...
 
Ekran Görüntüsünü birden fazla kişi ve kişilere mail atması

Merhaba,
Ekte makrolu ekran görüntüsünü ilgili kişilere mail atabilen bir tablo var bunu tek tuşla onlarca bayi'nin bilgilerini ekrana getirip ekran görüntüsü mailini otomatik olarak yapmasını istiyorum ;
manuel onlarca bayinin bilgilerini ekran görüntüsü olarak mail atıyorum tek tek yapıp zaman kaybet istemiyorum tek tuşla arka arkaya bayileri seçip bilgilerini ekrana getirip daha sonra ekran görüntüsünü mail atmasını istiyorum.
Yapılmak istenilen;
1 )P kolonundan bulunan bayi isimlerini sırayla seçmesi
2) Günlük Sheet'den advanced filter yap C11 hücresinden itibaren yapıştır
3)Aylık Sheet'den advanced filter yap Günlük raporunun 4 satır altından itibaren yapıştır
4)Q1 ve Q2 Hücresinde bulunan mail listesine(Formüllüdür) EKRAN GÖRÜNTÜSÜNÜ mail at
Dikkat edilmesi gereken nokta her bayinin kalem sayıları farklıdır advanced filter yapılırken bilgiler üst üste gelebilir.
otomatik makronun haricinde birde tüm bilgileri ekrana manuel mail atma makrosuda olursa minnettar kalırım yani iki makro olacak
iyi çalışmalar.
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Öncelikle geçmiş olsun demek istiyorum. Umarım önemli bir rahatsızlık yoktur.

Dosyanın da işinize yaramasına sevindim. Güle güle kullanın...

Korhan Bey,

Dosya ile ilgili küçük bir yardım daha isteyecektim. CC kısmında e-postası aynı olan kişiler olacak bu durumda her tarih için aynı kişiye birden fazla e-posta gidiyor. Bunu süzdürüp yapmak olmuyor.

Bu durumda tek bir çare kalıyor oda TO kısmında yazan e-postaları ; ayracı ile tek bir e-postada yollayıp CC kısmındaki kişileride süzüp aynı olan e-postaları tek yazıp bütün işi tek e-posta ile halletmek. Nasıl yaparız? :)
 
Bu arada Windows-Donatılar-Sistem Araçları-Görev Zamanlayıcı özelliğini kullanarak bilgisayarınızın açılışında otomatik mail atma şansınız var.
 
Merhaba,

Bizimde her ay 2-3 gün içinde ekli olarak yaklaşık 1000 kişiye mail atmamız gerekiyor.

toplu mail attığımız zaman sunucu bazlı sorun yaşıyoruz.

aslında excel'den yaptığınız gibi mail adreslerini yazsak ve outlook'tan tek tek mail atmasını

sağlayabilir miyiz.

mesela şöyle bir kod buldum. 50 kişiye 1'er dakika arayla mail gönder şeklinde ama nereye ekleyeceğimi bilmiyorum.

say = say + 1
if say = 50 then
Application.wait now+timeserial(0,1,0)
say = 0
end if

bu konuda çok acil desteğinizi rica ederim..

Teşekkürler
 
Son düzenleme:
Merhaba,

Sizde örnek dosyanızı paylaşım sitelerine ekleyip bağlantı linkini paylaşırsanız yardım almanız kolaylaşır.
 
Merhaba,

Daha önce burada paylaşılan bir kod vardı. Onu buldum (aşağıda)

Kod işime yarıyor ancak 1 kişiye değildi 10-20 kişiye aynı anda mail atmam gerekiyor ve maile dosya eklemem gerekiyor.

Koda dosya eklemeyi yazabilir misiniz.

yani D sütununa mail adreslerini yazacağım.

1 dakika ara ile 10-20 kişiye mail atacak

ve hepsine aynı dosya ekini göndereceğiz.



Kod:
Sub KOD()

'MAİL GÖNDERİMİ BAŞLANGIÇ
'NOT: TOOLS-REFERENCES TIKLA
'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For i = 2 To [D65536].End(3).Row

        Dim xlOutlook As Object
        Dim xlMail As Object
        Set xlOutlook = CreateObject("Outlook.Application")
        Set xlMail = xlOutlook.CreateItem(0)

        With xlMail
            .to = Cells(i, "D")
            .CC = ""
            .Subject = "Konu"
            .Body = "Sayın " & Cells(i, "B") & " " & Cells(i, "C") & Chr(10) & _
                    "Bir arkadaşımızın bitirme tezine yardımcı olmaktayız.Soru formu linkini tıklayarak ankete katılmanız çok fazla katkı sağlayacaktır . Şimdiden çok teşekkürler." & Chr(10) & _
                    "Saygılarımla;"
            .Importance = 2
            .Save
            .Send
        End With

        Application.Wait Now + TimeValue("00:01:00")

    Next i

    Set xlMail = Nothing
    Set xlOutlook = Nothing

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    MsgBox " B i t t i "
End Sub
 
Son düzenleme:
Korhan Bey merhaba,

Söz konusu kodunuz için teşekkür ederiz. Söz konusu mailleri ayrı ayrı olarak ekleriyle birlikte gönderme şansımız var mıdır?

Merhaba,

Aşağıdaki kodu deneyiniz.

A2 hücresinden başlamak üzere dosya isimlerinizi aralarına virgül ekleyerek yazınız...

Örnek; Deneme.xls,Deneme.pdf

B2 hücresinden başlamak üzere mail adreslerini aralarına noktalı virgül ekleyerek yazınız...

Örnek; aaaa@bbbb.com;cccc@dddd.com


Kod:
Option Explicit

Sub MAIL_GONDER()
    Dim Outlook_App As Object
    Dim Outlook_Mail As Object
    Dim S1 As Worksheet, X As Long, Y As Byte
    Dim Yol As String, Dosya As Variant
    
    Set Outlook_App = CreateObject("Outlook.Application")
    Set S1 = Sheets("Sayfa1")
    Yol = "C:\Deneme\"
    ChDir (Yol)
    
    For X = 2 To S1.Cells(S1.Rows.Count, 1).End(3).Row
        Dosya = Split(S1.Cells(X, 1), ",")
        Set Outlook_Mail = Outlook_App.CreateItem(0)
        With Outlook_Mail
            .To = S1.Cells(X, 2)
            .CC = ""
            .Subject = "Raporlar"
            .Body = "Sayın Yetkili," & Chr(10) & Chr(10) & _
                    "Günlük raporlarımız ekte bilgilerinize sunulmuştur."
             For Y = LBound(Dosya) To UBound(Dosya)
                 If Dir(Yol & Trim(Dosya(Y)), vbNormal) <> "" Then
                     .Attachments.Add Yol & Trim(Dosya(Y))
                 End If
             Next
            .BodyFormat = 2
            .Save
            '.Send
            .Display
        End With
    Next
    
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Tam olarak ne istediğinizi anlayamadım.
 
Yani her eklediğimiz pdf'i farklı kişilere düzenlenmesini sağlayabilir miyiz?

Örn; a.pdf,b.pdf
a.pdf-x kişisine ayrı bir mail olarak
b.pdf-y kişisine ayrı bir mail olarak

gönderme şansımız oluşabilir mi?

Şu an tüm kişileri gönderilecek kişilere ekliyor ve tüm ekleri de aynı mail içinde ekliyor.

Umarım anlatabilmişimdir.
 
Dosyanızda ki düzeni tarif ederseniz kodları revize edebilirim. Hatta örnek dosyanızı eklerseniz daha sağlıklı sonuçlar alabiliriz.
 
Korhan Bey merhaba,

Takip listesi ekte yer alan format şeklindedir.

Söz konusu her firma içinde aynı şekilde mutabakat mektupları firma unvanıyla aynı isimde pdf formatında yer almaktadır.

Dolayısıyla her firma için mutabakat formlarını her belirtilen mail için ayrı ayrı göndermek istiyorum.

Umarım doğru bir şekilde anlatabilmişimdir.
 

Ekli dosyalar

Aşağıdaki kodu deneyiniz.

Kod:
Option Explicit

Sub MAIL_GONDER()
    Dim Outlook_App As Object
    Dim Outlook_Mail As Object
    Dim S1 As Worksheet, X As Long, Y As Byte
    Dim Yol As String, Dosya As Variant
    
    Set Outlook_App = CreateObject("Outlook.Application")
    Set S1 = Sheets("Sayfa1")
    Yol = "C:\Deneme\"
    ChDir (Yol)
    
    For X = 6 To S1.Cells(S1.Rows.Count, 1).End(3).Row
        Dosya = S1.Cells(X, 3) & ".PDF"
        Set Outlook_Mail = Outlook_App.CreateItem(0)
        With Outlook_Mail
            .To = S1.Cells(X, 4)
            .CC = ""
            .Subject = "Mutabakat Raporu"
            .Body = "Sayın Yetkili," & Chr(10) & Chr(10) & _
                    S1.Range("C1").Text & " tarihi itibariyle sistemimizde görünen bakiyeniz ekli dosyada bilgilerinize sunulumuştur." & Chr(10) & _
                    "Kontrollerinizi yaptıktan sonra mutabakat sonucunu mail ortamında bildirmenizi rica ederim." & Chr(10) & Chr(10) & "İyi çalışmalar dilerim."
            .Attachments.Add Yol & Dosya
            .BodyFormat = 2
            .Save
            .Send
        End With
    Next
    
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Arkadaşlar merhaba,

otomatik mail gönderme ile ilgili office 2003 de çalışan kod 2007 çalışmıyor. "SUNUCU BİR İSTİSNA ATTI" diye uyarı veriyor. bu arada windows 10 yüklendi bilgisayara. bu sebepten de olabilir. bu konuda desteğinizi rica ederim.

Sub KOD()

'MAİL GÖNDERİMİ BAŞLANGIÇ
'NOT: TOOLS-REFERENCES TIKLA
'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

For i = 2 To [D65536].End(3).Row

Dim xlOutlook As Object
Dim xlMail As Object
Set xlOutlook = CreateObject("Outlook.Application")
Set xlMail = xlOutlook.CreateItem(0)

With xlMail
.To = Cells(i, "D")
.CC = ""
.Subject = "EVRAK BİLDİRİMİ"
.Body = "Sayın Yetkili, " & Cells(i, "B") & " " & Cells(i, "C") & Chr(10) & _
" " & Cells(i, "B") & " " & Cells(i, "C") & Chr(10) & _
"Personel SGK Borcu Yoktur yazısı, Muhtasar Beyannamesi, Muhtasar Tahakkuku ve Ödeme Dekontu ile Personel Maaş Bordrosu mail ekinde bilgilerinize sunulmuştur." & Chr(10) & _
"İyi Çalışmalar."


.Attachments.Add ("C:\Users\Dogukan\Desktop\HİZMET LİSTELERİ HAZİRAN\AKBANK İSTANBUL\AKBANK BEYOĞLU SİCİLİ.pdf")
.Attachments.Add ("C:\Users\Dogukan\Desktop\HİZMET LİSTELERİ HAZİRAN\AKBANK İSTANBUL\AKBANK KADIKÖY SİCİLİ.pdf")
.Attachments.Add ("C:\Users\Dogukan\Desktop\HİZMET LİSTELERİ HAZİRAN\AKBANK İSTANBUL\MARMARA SOSYAL HİZM.TURZ.TİC.VE SAN.A.Ş. 06-2016-06-2016 MUH BEYANNAME.pdf")
.Attachments.Add ("C:\Users\Dogukan\Desktop\HİZMET LİSTELERİ HAZİRAN\AKBANK İSTANBUL\MARMARA SOSYAL HİZM.TURZ.TİC.VE SAN.A.Ş. 06-2016-06-2016 MUH TAHAKKUK.pdf")
.Attachments.Add ("C:\Users\Dogukan\Desktop\HİZMET LİSTELERİ HAZİRAN\AKBANK İSTANBUL\MUHTASAR ÖDEME DEKONTU.html")
.Attachments.Add ("C:\Users\Dogukan\Desktop\HİZMET LİSTELERİ HAZİRAN\AKBANK İSTANBUL\SGK BORCU YOKTUR.pdf")
'.Importance = 2
.Save
.Send
End With

Application.Wait Now + TimeValue("00:01:07")

Next i

Set xlMail = Nothing
Set xlOutlook = Nothing

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
MsgBox " GÖNDERİLDİ "
End Sub
 
Son düzenleme:
Arkadaşlar Korhan beyin alıntıda vermiş olduğu kodlarda ufak bir düzenleme yapmam gerekiyor fakat sorunu çözemedim. "C:\Deneme\" klasörü içine eklediğim tüm dosyaları, yani dosya adı belirtmeyeceğim. Klasör içinde txt, pdf, jpg, xml gibi dosyalar olabilir. Dosya ismine ve uzantısına bakmaksızın klasörde mevcut olan tüm dosyaları ek olarak Sayfa1'in H5 hücresinde yazılı olan adreslerine yollamak için nasıl bir düzeltme yapmalıyım?

Merhaba,

Aşağıdaki kodu deneyiniz.

A2 hücresinden başlamak üzere dosya isimlerinizi aralarına virgül ekleyerek yazınız...

Örnek; Deneme.xls,Deneme.pdf

B2 hücresinden başlamak üzere mail adreslerini aralarına noktalı virgül ekleyerek yazınız...

Örnek; aaaa@bbbb.com;cccc@dddd.com


Kod:
Option Explicit

Sub MAIL_GONDER()
    Dim Outlook_App As Object
    Dim Outlook_Mail As Object
    Dim S1 As Worksheet, X As Long, Y As Byte
    Dim Yol As String, Dosya As Variant
    
    Set Outlook_App = CreateObject("Outlook.Application")
    Set S1 = Sheets("Sayfa1")
    Yol = "C:\Deneme\"
    ChDir (Yol)
    
    For X = 2 To S1.Cells(S1.Rows.Count, 1).End(3).Row
        Dosya = Split(S1.Cells(X, 1), ",")
        Set Outlook_Mail = Outlook_App.CreateItem(0)
        With Outlook_Mail
            .To = S1.Cells(X, 2)
            .CC = ""
            .Subject = "Raporlar"
            .Body = "Sayın Yetkili," & Chr(10) & Chr(10) & _
                    "Günlük raporlarımız ekte bilgilerinize sunulmuştur."
             For Y = LBound(Dosya) To UBound(Dosya)
                 If Dir(Yol & Trim(Dosya(Y)), vbNormal) <> "" Then
                     .Attachments.Add Yol & Trim(Dosya(Y))
                 End If
             Next
            .BodyFormat = 2
            .Save
            '.Send
            .Display
        End With
    Next
    
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
çok eski bir konu ama ben şimdi denedim :) fakat çalışmıyor :( yardımcı olabilecek biri var mı?

(excel2016)
 
Geri
Üst