AccessTr.neT

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

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

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

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

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 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

Hayırlısı abey