DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub Mail_Gönder()
Dim OutApp As Object
Dim OutMail As Object
Dim X As Integer, Adres As String, Y As Byte
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
For X = 1 To Range("A65336").End(3).Row Step 10
Adres = ""
For Y = X To X + 9
Adres = IIf(Adres = "", Cells(Y, 1), Adres & ";" & Cells(Y, 1))
Next
With OutMail
.To = Adres
.CC = ""
.BCC = ""
.Subject = "konu"
.Body = "Yazi"
.Attachments.Add ("C:\test.xls")
.Send
'.Display
Application.Wait Now + TimeValue("00:00:05")
End With
Next
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Selamlar,
Bu durumda tek tek yollamanız daha mantıklıdır.
Option Explicit
Sub Mail_Gönder()
Dim OutApp As Object
Dim OutMail As Object
Dim X As Integer
Set OutApp = CreateObject("Outlook.Application")
For X = 1 To Range("A65336").End(3).Row
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Cells(X, 1)
.CC = ""
.BCC = ""
.Subject = "konu"
.Body = "Yazi"
.Attachments.Add ("C:\test.xls")
.Send
'.Display
Application.Wait Now + TimeValue("00:00:05")
End With
Next
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub