Excel Outlook İle Dosya Ekli Toplu Mail Gönderme

1 2 3 4 5 6 7 8
10/04/2021, 11:13

Oğuz Türkyılmaz

Önceki kodda hata vermişti bunda da deneme yapıp dönüş yaparım Feraz hocam
10/04/2021, 11:26

feraz

syfAna.Range("D2 Yukardaki D yerine G gelecekti abey.
10/04/2021, 11:38

Oğuz Türkyılmaz

Birazdan eve geçip evdeki bilgisayarda deneyip dönüş yapacağım bu bilgisayarda hata vermiyor ama gönderim de yapmıyor.
10/04/2021, 11:43

feraz

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
10/04/2021, 13:42

Oğuz Türkyılmaz

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

10/04/2021, 17:29

feraz

Hayırlısı abey
1 2 3 4 5 6 7 8