- Katılım
- 27 Ocak 2011
- Mesajlar
- 1,231
- Excel Vers. ve Dili
- Ofis 2013 Türkçe
Merhaba
Mail konusuna yeni uğraşmaya başladım
Aşağıdaki kodlarda istediğim şekilde mail atabiliyorum
Sadece gönderilen mailler giden kutusunda görülmüyor
Bunun gözükmesi için kodlara ne eklemem gerekiyor veya ne yapmam gerekiyor
Mail konusuna yeni uğraşmaya başladım
Aşağıdaki kodlarda istediğim şekilde mail atabiliyorum
Sadece gönderilen mailler giden kutusunda görülmüyor
Bunun gözükmesi için kodlara ne eklemem gerekiyor veya ne yapmam gerekiyor
Kod:
Sub TopluManuel ()
Dim S1, S2 As Worksheet
Set S1 = Sheets("MAİL-LİSTESİ")
Set S2 = Sheets("MAİL")
For i = 5 To S2.Cells(Rows.Count, "F").End(xlUp).Row
If Not S2.Cells(i, "G") = "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
If CreateObject("Scripting.FileSystemObject").FileExists(S2.Range("E" & i).Value) = False Then MsgBox (S2.Range("E" & i).Value & Chr(10) & "Eklenecek dosyayı bulamadı"): Exit Sub
On Error Resume Next
With OutMail
.To = S2.Cells(i, "F").Value.
.CC = ""
.BCC = ""
.Attachments.Add S2.Range("E" & i).Value
.Subject = S2.Range("K2").Value 'Konu kısmını yazdığımız yerden alıyoruz.
.Body = S2.Range("K3").Value 'Gövde metni kısmını yazdığımız yerden alıyoruz.
' .SendUsingAccount = OutApp.Session.Accounts.Item(3)
' .Display
‘ .Save
.Send 'or use .Display
.OriginatorDeliveryReportRequested = True
Say = Say + 1
S2.Cells(i, "I") = "Evet"
S2.Cells(i, "J") = Format(Date, "dd/mm/yyyy")
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next i
MsgBox "İşleminiz tamamlanmıştır." & vbNewLine & "Toplam gönderilen mail sayısı ; " & Say
End Sub
