Merhaba
1-Aşağıdaki kodla gönderim yapılıyor lakin Y sütunundaki maillere tek tek yollayınca işlem uzun sürüyor benim istediğim Z sütununda evet olanlara tek seferde dosyayı yükleyip hepsine maili atsın yani bir seferde 8 mail evetse 8 inide atsın gibi
2-Gönderimin yapılıp yapılmadığını gözükmediği için bekleme süresi falan yaptım. Gönderim teyit edilirse onu ekleyebilirsek güzel olur
Sub mailcoklu()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim mesaj As String
Dim cevap As Integer
ActiveSheet.Unprotect "24167"
mesaj = "Dosya Mail Olarak Gönderilsinmi?"
cevap = MsgBox(mesaj, vbOKCancel + vbQuestion)
If cevap = vbOK Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("Y").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "Z").Value) = "evet" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Günlük Satış Bilgileri"
.Body = "Kolay gelsin" & Cells(cell.Row, "X").Value _
& vbNewLine & vbNewLine & _
"Gerekli bilgilendirme için "
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
Application.Wait Now + TimeValue("00:00:20")
MsgBox "Mail gönderimi başarılı outlook tan kontrol edebilirsiniz"
End If
ActiveSheet.Protect "24167"
End Sub
1-Aşağıdaki kodla gönderim yapılıyor lakin Y sütunundaki maillere tek tek yollayınca işlem uzun sürüyor benim istediğim Z sütununda evet olanlara tek seferde dosyayı yükleyip hepsine maili atsın yani bir seferde 8 mail evetse 8 inide atsın gibi
2-Gönderimin yapılıp yapılmadığını gözükmediği için bekleme süresi falan yaptım. Gönderim teyit edilirse onu ekleyebilirsek güzel olur
Sub mailcoklu()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim mesaj As String
Dim cevap As Integer
ActiveSheet.Unprotect "24167"
mesaj = "Dosya Mail Olarak Gönderilsinmi?"
cevap = MsgBox(mesaj, vbOKCancel + vbQuestion)
If cevap = vbOK Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("Y").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "Z").Value) = "evet" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Günlük Satış Bilgileri"
.Body = "Kolay gelsin" & Cells(cell.Row, "X").Value _
& vbNewLine & vbNewLine & _
"Gerekli bilgilendirme için "
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
Application.Wait Now + TimeValue("00:00:20")
MsgBox "Mail gönderimi başarılı outlook tan kontrol edebilirsiniz"
End If
ActiveSheet.Protect "24167"
End Sub
