AccessTr.neT
Excel Outlook İle Dosya Ekli Toplu Mail Gönderme - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Excel Outlook İle Dosya Ekli Toplu Mail Gönderme (/konu-excel-outlook-ile-dosya-ekli-toplu-mail-gonderme.html)

Sayfalar: 1 2 3 4 5 6 7 8


RE: Excel Outlook İle Dosya Ekli Toplu Mail Gönderme - Oğuz Türkyılmaz - 10/04/2021

Önceki kodda hata vermişti bunda da deneme yapıp dönüş yaparım Feraz hocam


RE: Excel Outlook İle Dosya Ekli Toplu Mail Gönderme - feraz - 10/04/2021

syfAna.Range("D2Lol"
Yukardaki D yerine G gelecekti abey.


RE: Excel Outlook İle Dosya Ekli Toplu Mail Gönderme - Oğuz Türkyılmaz - 10/04/2021

Birazdan eve geçip evdeki bilgisayarda deneyip dönüş yapacağım bu bilgisayarda hata vermiyor ama gönderim de yapmıyor.


Re: Excel Outlook İle Dosya Ekli Toplu Mail Gönderme - feraz - 10/04/2021

Bu şekilde yaptım bunu deneyin abey normalde çalışıyor.
Hata verirse hatalı olarak dosyayı yükleyin bakalım müsait oluncak.

Private Sub CommandButton2_Click()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim maill As String
    Dim i As Long, ek
    Dim syfAna As Worksheet
    Dim basla, bitis
 
    Set syfAna = ThisWorkbook.Sheets("Ana_Sayfa")
   
    ChDir (ThisWorkbook.Path & Application.PathSeparator)
    ek = Application.GetOpenFilename("Files (*.**)," & "*.**", 1, "Select File", "Open", False)
    If ek = vbNullString Then Exit Sub
    If ek = False Then Exit Sub

    basla = InputBox("Baþlangýç ID numarasýný Giriniz.")
    If basla < 2 Then Exit Sub
    If basla = "" Then Exit Sub
    bitis = InputBox("Bitiþ ID numarasýný Giriniz.")
    If bitis = "" Then Exit Sub
   
    If IsNumeric(basla) = False Then Exit Sub
    If IsNumeric(bitis) = False Then Exit Sub
    If basla > bitis Then Exit Sub
    If WorksheetFunction.CountA(syfAna.Range("G2:G" & Rows.Count)) = 0 Then GoTo son
    For i = Val(basla) To Val(bitis)
var2:
        If Trim(syfAna.Range("G" & i).Value) <> "" Then maill = maill & syfAna.Range("G" & i).Value & ";"
        If i Mod 100 = 0 Then Exit For
    Next
        i = i + 1
        maill = Left(maill, Len(maill) - 1)

        Set objOutlook = CreateObject("Outlook.Application")
        Set objMail = objOutlook.CreateItem(0)
        With objMail
            .To = maill
            .Subject = "2021 WINPERAX Teknik Ürün Kataloðu"
            .body = "Sayýn yetkili, Ekte 2021 WINPERAX Teknik Ürün Kataloðu bulunmaktadýr. Ýyi Çalýþmalar Dileriz.Saygýlarýmýzla,"
            .Attachments.Add ek
            .Importance = 2
            .Save
            .Display
            .Send ' gönder
            Application.Wait (Now + TimeValue("0:00:20"))
        End With
        maill = vbNullString
        If i >= bitis Then GoTo var
        GoTo var2
var:
        MsgBox "Gönderildi..", vbInformation, "Bilgi"

    Set objMail = Nothing
    Set objOutlook = Nothing
    Set syfAna = Nothing
    Exit Sub
son:
    MsgBox "Hata oldu", vbCritical, "Hata"
    GoTo var
End Sub



RE: Excel Outlook İle Dosya Ekli Toplu Mail Gönderme - Oğuz Türkyılmaz - 10/04/2021

Feraz Hocam Zaman Ayarını .59 saniye modu da 5 olarak ayarladım. 59 saniyede bir 5 er 5 er 4 defada mailleri gönderdi acayip güzel oldu Img-grin Elleriniz dert görmesin. Normalde 50 li partiler halinde gönderirim. Bu şekilde de spam olarak algılanmaz mailler umarım. İnşallah sorun yaşamam

[Resim: do.php?img=10881]


RE: Excel Outlook İle Dosya Ekli Toplu Mail Gönderme - feraz - 10/04/2021

Hayırlısı abey Img-grin