- Katılım
- 6 Temmuz 2008
- Mesajlar
- 1,875
- Excel Vers. ve Dili
- OFFİCE 2010- TÜRKÇE
- Altın Üyelik Bitiş Tarihi
- 22-12-2019
Hayırlı akşamlar,
Aşağıdaki kodlarda sayfada mail adresleri bulunan kişilere mail atmak istiyorum fakat ne hikmetse hatayı bir türlü çözemedim.
İlk satırdaki kişiye mail gidiyor sonraki döngüde "Öğe taşınmış yada silinmiş" hatası geliyor (kırmızı renkli satırda debug )
Kodların çalıştığına eminim çünkü tek tek mail atabiliyorum . Döngü girince hata veriyor.
Aşağıdaki kodlarda sayfada mail adresleri bulunan kişilere mail atmak istiyorum fakat ne hikmetse hatayı bir türlü çözemedim.
İlk satırdaki kişiye mail gidiyor sonraki döngüde "Öğe taşınmış yada silinmiş" hatası geliyor (kırmızı renkli satırda debug )
Kodların çalıştığına eminim çünkü tek tek mail atabiliyorum . Döngü girince hata veriyor.
Kod:
Option Explicit
Dim yol As String
Dim Dosya_Adi As String
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Dim cl As Worksheet, Onay As Byte
Dim sat
Dim pdfdosya
Sub toplu_MAIL_GONDER()
Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)
Set cl = Sheets("CariListesi")
'On Error Resume Next
For sat = 5 To cl.Cells(Rows.Count, "A").End(3).Row
If cl.Cells(sat, "E") <> "" And cl.Cells(sat, "G") <> "" Then
pdfdosya = cl.Cells(sat, "G")
yol = ThisWorkbook.Path & "\Gönderilmiş\" & cl.Cells(sat, "B")
Dosya_Adi = yol & "\" & pdfdosya
ChDir yol
With Outlook_Mail
[COLOR="Red"][B].To = cl.Cells(sat, "E")[/B][/COLOR]
.CC = cl.Cells(sat, "F")
.BCC = cl.Cells(3, "B")
.Subject = cl.Cells(1, "B")
.Body = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf _
& cl.Cells(5, "C") & " Tarihli Mutabakat formu ekte bilgilerinize sunulmuştur." & vbCrLf & vbCrLf & _
"Mutabık olduğunuza dair imzalı kaşeli görselini tarafımıza göndermeniz rica olunur" _
& vbCrLf & "Saygılarımla" & vbCrLf & "İyi çalışmalar dileriz."
.Attachments.Add Dosya_Adi & ".pdf"
.BodyFormat = 2
.Save
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
.Send
'.Display
End With
End If
Next sat
MsgBox sat - 5 & " Firmaya mail Gönderilmiştir.", vbInformation
Set cl = Nothing
Set Outlook_Mail = Nothing
Set Outlook_App = Nothing
End Sub