• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

macroyu her seferinde bir alt satır için çalıştırma

Set evn = Nothing: Set objOlk = Nothing
Set objevn = Nothing: Set objEkle = Nothing
evngovde = vbNullString: Set ek = Nothing
Rows("1:1").Select
Selection.Delete Shift:=xlUp
h = h -1
End If
Next h

Bu satırı ekleyerek bir deneyiniz.
 
ExcelF1' Alıntı:
Set evn = Nothing: Set objOlk = Nothing
Set objevn = Nothing: Set objEkle = Nothing
evngovde = vbNullString: Set ek = Nothing
Rows("1:1").Select
Selection.Delete Shift:=xlUp
h = h -1
End If
Next h

Bu satırı ekleyerek bir deneyiniz.
Genişletmek için tıkla ...

Denemek için kodu aşşağıdaki gibi değiştirdim, ancak kod 5 te durmadı devam etti.

Dim firma
aa = [b65536].End(3).Row
If aa = "" Then
Exit Sub
End If
For h = 1 To 5
If Application.Wait(Now + TimeValue("0:00:02")) Then

firma = Range("b" & h)
strresmim = Range("h" & h) & ".jpg"
Set objOlk = CreateObject("Outlook.Application")
Set evn = objOlk.CreateItem(0)
evn.To = Range("f" & h)
evn.Subject = Range("g" & h)
evngovde = "<br></br>" & "<a></a>" & _
Range("c" & h) & " " & "Yeni Yılda Yine <b> Kurumsal Market </b>" & _
"<br><br>*******Yeni Yılda Kartuş Toner ve Şerit İhtiyaçlarınız İçin Size Yepyeni Bir Fırsat" & _
"<br>*******En Ucuz Fiyatlarla Tekrar Karşınızdayız" & _
"<br>*******Kargo <b>SADECE 1,00 TL</b>" & _
"<br> </br>" & _
"<br>*******Satın aldığınız her ürün adınıza faturalı olarak kapınıza gelir ve beğeninize sunulur.<br>" & _
"<br> <br>" & _
"<br><b>En Güvenli Ödeme Şekilleri :</b><br>" & _
"******-*Kapıda Ödeme<br>" & _
"******-*Kredi Kartı İle Ödeme<br>" & _
"******-*Hesaba Havale<br>"
Set objEkle = evn.Attachments
Set objevn = objEkle.Add(strresmim)
evn.Close olSave
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>"
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>" & _
"<br><br>Erman USTA<br>" & _
"<b>Satış Temsilcisi</b><br>" & _
"0532 341 12 19<br><br>" & _
"<b>Online Sipariş için: www.KURUMSALmarket.com</b><br>" & _
"<br> <br>" & _
Range("c" & h) & " " & "*******Müşterilerimiz için ve verdileri referanslar doğrultusunda hazırladığımız bu mail, sizin daha iyi şartlar altında çalışmanızı sağlamak amacı ile gönderilmiştir. Eğer size yardımcı olmamızı istemiyorsanız bu mesaja 'istemiyorum' yazarak cevap verebilirsiniz.<br>"
evn.Save
evn.send
strresmim = vbNullString
Set evn = Nothing: Set objOlk = Nothing
Set objevn = Nothing: Set objEkle = Nothing
evngovde = vbNullString: Set ek = Nothing

End If
Rows("1:1").Delete
h = h - 1
Next h

'Rows("1:95").Delete
MsgBox "İşlem Tamam Patron", vbInformation
End Sub
 
Kod: 
Dim firma
aa = [b65536].End(3).Row
If aa = "" Then
Exit Sub
End If
[B]h = 1 : x = 0
10[/B]
If Application.Wait(Now + TimeValue("0:00:02")) Then
firma = Range("b" & h)
strresmim = Range("h" & h) & ".jpg"
Set objOlk = CreateObject("Outlook.Application")
Set evn = objOlk.CreateItem(0)
evn.To = Range("f" & h)
evn.Subject = Range("g" & h)
evngovde = "<br></br>" & "<a></a>" & _
Range("c" & h) & " " & "Yeni Yılda Yine <b> Kurumsal Market </b>" & _
"<br><br>*******Yeni Yılda Kartuş Toner ve Şerit İhtiyaçlarınız İçin Size Yepyeni Bir Fırsat" & _
"<br>*******En Ucuz Fiyatlarla Tekrar Karşınızdayız" & _
"<br>*******Kargo <b>SADECE 1,00 TL</b>" & _
"<br> </br>" & _
"<br>*******Satın aldığınız her ürün adınıza faturalı olarak kapınıza gelir ve beğeninize sunulur.<br>" & _
"<br> <br>" & _
"<br><b>En Güvenli Ödeme Şekilleri :</b><br>" & _
"******-*Kapıda Ödeme<br>" & _
"******-*Kredi Kartı İle Ödeme<br>" & _
"******-*Hesaba Havale<br>"
Set objEkle = evn.Attachments
Set objevn = objEkle.Add(strresmim)
evn.Close olSave
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>"
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>" & _
"<br><br>Erman USTA<br>" & _
"<b>Satış Temsilcisi</b><br>" & _
"0532 341 12 19<br><br>" & _
"<b>Online Sipariş için: www.KURUMSALmarket.com</b><br>" & _
"<br> <br>" & _
Range("c" & h) & " " & "*******Müşterilerimiz için ve verdileri referanslar doğrultusunda hazırladığımız bu mail, sizin daha iyi şartlar altında çalışmanızı sağlamak amacı ile gönderilmiştir. Eğer size yardımcı olmamızı istemiyorsanız bu mesaja 'istemiyorum' yazarak cevap verebilirsiniz.<br>"
evn.Save
evn.send
strresmim = vbNullString
Set evn = Nothing: Set objOlk = Nothing:Set objevn = Nothing: Set objEkle = Nothing:evngovde = vbNullString: Set ek = Nothing
End If
[B]
Rows(1).Delete
x = x + 1
if x <> 5 then goto 10[/B]

MsgBox "İşlem Tamam Patron", vbInformation
End Sub

Dosyanızı görmeden cevap yazmak zor oluyor.
Üstteki şekilde bir dener misiniz.
 
ExcelF1' Alıntı:
Kod: 
Dim firma
aa = [b65536].End(3).Row
If aa = "" Then
Exit Sub
End If
[B]h = 1 : x = 0
10[/B]
If Application.Wait(Now + TimeValue("0:00:02")) Then
firma = Range("b" & h)
strresmim = Range("h" & h) & ".jpg"
Set objOlk = CreateObject("Outlook.Application")
Set evn = objOlk.CreateItem(0)
evn.To = Range("f" & h)
evn.Subject = Range("g" & h)
evngovde = "<br></br>" & "<a></a>" & _
Range("c" & h) & " " & "Yeni Yılda Yine <b> Kurumsal Market </b>" & _
"<br><br>*******Yeni Yılda Kartuş Toner ve Şerit İhtiyaçlarınız İçin Size Yepyeni Bir Fırsat" & _
"<br>*******En Ucuz Fiyatlarla Tekrar Karşınızdayız" & _
"<br>*******Kargo <b>SADECE 1,00 TL</b>" & _
"<br> </br>" & _
"<br>*******Satın aldığınız her ürün adınıza faturalı olarak kapınıza gelir ve beğeninize sunulur.<br>" & _
"<br> <br>" & _
"<br><b>En Güvenli Ödeme Şekilleri :</b><br>" & _
"******-*Kapıda Ödeme<br>" & _
"******-*Kredi Kartı İle Ödeme<br>" & _
"******-*Hesaba Havale<br>"
Set objEkle = evn.Attachments
Set objevn = objEkle.Add(strresmim)
evn.Close olSave
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>"
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>" & _
"<br><br>Erman USTA<br>" & _
"<b>Satış Temsilcisi</b><br>" & _
"0532 341 12 19<br><br>" & _
"<b>Online Sipariş için: www.KURUMSALmarket.com</b><br>" & _
"<br> <br>" & _
Range("c" & h) & " " & "*******Müşterilerimiz için ve verdileri referanslar doğrultusunda hazırladığımız bu mail, sizin daha iyi şartlar altında çalışmanızı sağlamak amacı ile gönderilmiştir. Eğer size yardımcı olmamızı istemiyorsanız bu mesaja 'istemiyorum' yazarak cevap verebilirsiniz.<br>"
evn.Save
evn.send
strresmim = vbNullString
Set evn = Nothing: Set objOlk = Nothing:Set objevn = Nothing: Set objEkle = Nothing:evngovde = vbNullString: Set ek = Nothing
End If
[B]
Rows(1).Delete
x = x + 1
if x <> 5 then goto 10[/B]

MsgBox "İşlem Tamam Patron", vbInformation
End Sub

Dosyanızı görmeden cevap yazmak zor oluyor.
Üstteki şekilde bir dener misiniz.
Genişletmek için tıkla ...

dosyayı eke iliştirdim.
en son yazdığınız makroda, sona gelmeden makro durduğunda "makro bittikten sonraki sileceği satır sayısı kadar" satırı siliyor.
bazen outlookta sorun çıkıyor ve makroyu durdurmam gerekiyor. bu noktada gönderilmemiş mail adresleri siliniyor.

yani kıssadan hisse, makronun çalışma mantığı,

1-1'inci satırdaki adrese mail gönder
2-mail gönderdiğin satırı sil
3-2.satırdaki (tabi bu noktada 2.satırdaki mail silinen satır yüzünden 1.satıra düşmüş olacak) maili gönder
4-mail gönderdiğin satırı sil

satır silme işin içine girdiği için mantık şöyle değişiyor.

1-1'inci satırdaki adrese mail gönder
2-1'inci satırı sil
3-1'inci satırdaki adrese mail gönder
4-1'inci satırı sil
.
.
.

bu şekilde en son 100 mail gönderdikten sonra makro "dur" ve yeniden çalıştırılmayı bekle, beklerken dosyayı kaydetmesi de iyi olur tabi.
 

Ekli dosyalar

Eklemiş olduğunuz dosyaya, 23 nolu mesajdaki kodları uyguladığımda bahsettiğiniz sorun ile karşılaşmadım.

Mevcut kodun yaptığı işlem;

1. 1.satırdaki adrese e-mail gönderir
2. E-mail gönderilen satırı siler (1.satır)
3. Silme işleminden sonra (2.satır 1.satır şekline gelecektir ve yine) 1.satırdaki adrese e-mail gönderir
4. Yine e-mail gönderilen satırı siler (1.satır)
5. Bu işlemi belirtilen miktar kadar yapar. (Bu kodlar ile 5 kez yapıp, duracaktır)
6. Gönderilen 5 e-mail sonrasında dosyayı kaydeder ve tekrar butona basılana kadar bekler.

Kod: 
Dim firma
aa = [b65536].End(3).Row
If aa = "" Then
Exit Sub
End If
h = 1 : x = 0
10
If Application.Wait(Now + TimeValue("0:00:02")) Then
firma = Range("b" & h)
strresmim = Range("h" & h) & ".jpg"
Set objOlk = CreateObject("Outlook.Application")
Set evn = objOlk.CreateItem(0)
evn.To = Range("f" & h)
evn.Subject = Range("g" & h)
evngovde = "<br></br>" & "<a></a>" & _
Range("c" & h) & " " & "Yeni Yılda Yine <b> Kurumsal Market </b>" & _
"<br><br>*******Yeni Yılda Kartuş Toner ve Şerit İhtiyaçlarınız İçin Size Yepyeni Bir Fırsat" & _
"<br>*******En Ucuz Fiyatlarla Tekrar Karşınızdayız" & _
"<br>*******Kargo <b>SADECE 1,00 TL</b>" & _
"<br> </br>" & _
"<br>*******Satın aldığınız her ürün adınıza faturalı olarak kapınıza gelir ve beğeninize sunulur.<br>" & _
"<br> <br>" & _
"<br><b>En Güvenli Ödeme Şekilleri :</b><br>" & _
"******-*Kapıda Ödeme<br>" & _
"******-*Kredi Kartı İle Ödeme<br>" & _
"******-*Hesaba Havale<br>"
Set objEkle = evn.Attachments
Set objevn = objEkle.Add(strresmim)
evn.Close olSave
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>"
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>" & _
"<br><br>Erman USTA<br>" & _
"<b>Satış Temsilcisi</b><br>" & _
"0532 341 12 19<br><br>" & _
"<b>Online Sipariş için: www.KURUMSALmarket.com</b><br>" & _
"<br> <br>" & _
Range("c" & h) & " " & "*******Müşterilerimiz için ve verdileri referanslar doğrultusunda hazırladığımız bu mail, sizin daha iyi şartlar altında çalışmanızı sağlamak amacı ile gönderilmiştir. Eğer size yardımcı olmamızı istemiyorsanız bu mesaja 'istemiyorum' yazarak cevap verebilirsiniz.<br>"
evn.Save
evn.send
strresmim = vbNullString
Set evn = Nothing: Set objOlk = Nothing:Set objevn = Nothing: Set objEkle = Nothing:evngovde = vbNullString: Set ek = Nothing
End If

Rows(1).Delete
x = x + 1
[B][COLOR="Red"]if x <> [COLOR="Blue"]5[/COLOR] then goto 10[/COLOR][/B]
[B]'Buradaki 5 rakamı gönderilecek mail miktarını belirler. Siz 100 yazarsanız 100 tane gönderir.[/B]

MsgBox "İşlem Tamam Patron", vbInformation
ThisWorkbook.Save
End Sub
 
teşekkür ederim dediğiniz doğrudur.
güvenli bir gönderim yapmak için maksadım, makro herhangibir şekilde yada manuel olarak "esc" tuşuyla durdurulduğunda sadece gönderi yaptığı kadarını silmekti.
bu makro 100 mail göndermeye uyarlandığında, manuel olarak attığı 25 mailden sonra durdurulduğunda 25 değil 100 maili siliyor.
ancak buna çözüm yoksa yapıcak bişey yok...
 
Maalesef benim bilgim, Size yardımcı olmaya yetmedi. Son olarak işinize yarar mı bilmem ama, kodun çalışması esnasında Esc tuşunu deaktif etmek ve işlem sonunda tekrar aktif etmek için;

Kodun en başına;
Application.EnableCancelKey = xlDisabled

Ve en sonuna;
Application.EnableCancelKey = xlInterrupt

yazabilirsiniz. Kolay gelsin.
 
ExcelF1' Alıntı:
Maalesef benim bilgim, Size yardımcı olmaya yetmedi. Son olarak işinize yarar mı bilmem ama, kodun çalışması esnasında Esc tuşunu deaktif etmek ve işlem sonunda tekrar aktif etmek için;

Kodun en başına;
Application.EnableCancelKey = xlDisabled

Ve en sonuna;
Application.EnableCancelKey = xlInterrupt

yazabilirsiniz. Kolay gelsin.
Genişletmek için tıkla ...

Yardımlarınız için çok teşekkür ederim.
kolay gelsin,
 
hamitcan' Alıntı:
Aşağıdaki linkleri inceleyin, galiba sizin konu ile ilgili.
http://www.outlookforums.com/threads/8209-add-hyperlink-email-body-vba/
http://www.pcreview.co.uk/forums/add-hyperlink-email-body-vba-t3795370.html
http://www.vbaexpress.com/forum/showthread.php?t=18630
Genişletmek için tıkla ...

Hamit Bey,

sizin verdiğiniz linklerden yola çıkarak
http://social.msdn.microsoft.com/Forums/en-US/outlookdev/thread/a4ab3e29-35fa-41dd-995d-fd7dcd20fd1b
bu linkteki bilgiye ulaştım
sanırım burada net olarak açıklanmış ancak macro bilgin acemi düzeyde olduğu için elimdeki macronun neresine ne şekilde entegre edeceğimi anlayamadım.
yardımcı olabilir misiniz?

teşekkürler..
 
Birşeyler yaptım ama umarım istedğiniz böyle birşeydir.
Kod: 
Sub gonder2()
Application.EnableCancelKey = xlDisabled


Dim firma
aa = [b65536].End(3).Row
If aa = "" Then
Exit Sub
End If
h = 1: x = 0
10
If Application.Wait(Now + TimeValue("0:00:02")) Then
firma = Range("b" & h)
'strresmim =  Range("h" & h) & ".jpg"
[color=red]strresmim = ThisWorkbook.Path & "\" & Range("h" & h) & ".jpg" ' Eklediğim[/color]
Set objOlk = CreateObject("Outlook.Application")
Set evn = objOlk.CreateItem(0)
evn.To = Range("f" & h)
evn.Subject = Range("g" & h)
evngovde = "<br></br>" & "<a></a>" & _
Range("c" & h) & " " & "Yeni Yılda Yine <b> Kurumsal Market </b>" & _
"<br><br>*******Yeni Yılda Kartuş Toner ve Şerit İhtiyaçlarınız İçin Size Yepyeni Bir Fırsat" & _
"<br>*******En Ucuz Fiyatlarla Tekrar Karşınızdayız" & _
"<br>*******Kargo <b>SADECE 1,00 TL</b>" & _
"<br> </br>" & _
"<br>*******Satın aldığınız her ürün adınıza faturalı olarak kapınıza gelir ve beğeninize sunulur.<br>" & _
"<br> <br>" & _
"<br><b>En Güvenli Ödeme Şekilleri :</b><br>" & _
"******-*Kapıda Ödeme<br>" & _
"******-*Kredi Kartı İle Ödeme<br>" & _
"******-*Hesaba Havale<br>"
Set objEkle = evn.Attachments
Set objevn = objEkle.Add(strresmim)
evn.Close olSave
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>"
evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
strresmim & "'' align=baseline border=0><br></BODY>" & _
"<br><br>Erman USTA<br>" & _
"<b>Satış Temsilcisi</b><br>" & _
"0532 341 12 19<br><br>" & _
"<b>Online Sipariş için: www.KURUMSALmarket.com</b><br>" & _
"<br> <br>" & _
Range("c" & h) & " " & "*******Müşterilerimiz için ve verdileri referanslar doğrultusunda hazırladığımız bu mail, sizin daha iyi şartlar altında çalışmanızı sağlamak amacı ile gönderilmiştir. Eğer size yardımcı olmamızı istemiyorsanız bu mesaja 'istemiyorum' yazarak cevap verebilirsiniz.<br>"
evn.Save
evn.send
strresmim = vbNullString
Set evn = Nothing: Set objOlk = Nothing: Set objevn = Nothing: Set objEkle = Nothing: evngovde = vbNullString: Set ek = Nothing
End If
 

Rows(1).Delete
x = x + 1
If x <> 5 Then GoTo 10
'Buradaki 5 rakamı gönderilecek mail miktarını belirler. Siz 100 yazarsanız 100 tane gönderir.

MsgBox "İşlem Tamam Patron", vbInformation
ThisWorkbook.Save
Application.EnableCancelKey = xlInterrupt
End Sub
 

Ekli dosyalar

Hamit bey,
yaptığınız doğrudur ancak yapılması istenen durum "email içerisinde herhangi bir yazıya yada resime hyperlink eklemek"
yani mailin ulaştığı kullanıcı mailde istenen adrese kolayca gitmesini sağlayacak bir tıklama sistemi.
 
Daha önce bu soru, forumda, Recep Bey tarafından cevaplanmış. Aşağıdaki linki inceleyebilirsiniz.
http://www.excel.web.tr/f48/outlook-mesaj-305-na-dosya-yolu-hyperlink-vermek-t39136.html
Kod: 
Sub gonder2()
Application.EnableCancelKey = xlDisabled


Dim firma
aa = [b65536].End(3).Row
If aa = "" Then
Exit Sub
End If
h = 1: x = 0
10
If Application.Wait(Now + TimeValue("0:00:02")) Then
firma = Range("b" & h)
'strresmim =  Range("h" & h) & ".jpg"
strresmim = ThisWorkbook.Path & "\" & Range("h" & h) & ".jpg" ' Eklediğim
Set objOlk = CreateObject("Outlook.Application")
Set evn = objOlk.CreateItem(0)
evn.To = Range("f" & h)
evn.Subject = Range("g" & h)
            evngovde = "<br></br>" & "<a></a>" & _
        Range("c" & h) & " " & "Yeni Yılda Yine <b> Kurumsal Market </b>" & _
    "<br><br>*******Yeni Yılda Kartuş Toner ve Şerit İhtiyaçlarınız İçin Size Yepyeni Bir Fırsat" & _
    "<br>*******En Ucuz Fiyatlarla Tekrar Karşınızdayız" & _
    "<br>*******Kargo <b>SADECE 1,00 TL</b>" & _
    "<br>       </br>" & _
    "<br>*******Satın aldığınız her ürün adınıza faturalı olarak kapınıza gelir ve beğeninize sunulur.<br>" & _
    "<br>       <br>" & _
    "<br><b>En Güvenli Ödeme Şekilleri :</b><br>" & _
    "******-*Kapıda Ödeme<br>" & _
    "******-*Kredi Kartı İle Ödeme<br>" & _
    "******-*Hesaba Havale<br>"
        Set objEkle = evn.Attachments
        Set objevn = objEkle.Add(strresmim)
        evn.Close olSave
        evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
        strresmim & "'' align=baseline border=0><br></BODY>"
        evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
        strresmim & "'' align=baseline border=0><br></BODY>" & _
            "<br><br>Erman USTA<br>" & _
            "<b>Satış Temsilcisi</b><br>" & _
            "0532 341 12 19<br><br>" & _
 [COLOR=RED]           "<b>Online Sipariş için:</b>  <A HREF= ""C:\Deneme\deneme.xls""> www.KURUMSALmarket.com </A></b><br>" & _[/COLOR]
            Range("c" & h) & " " & "*******Müşterilerimiz için ve verdileri referanslar doğrultusunda hazırladığımız bu mail, sizin daha iyi şartlar altında çalışmanızı sağlamak amacı ile gönderilmiştir. Eğer size yardımcı olmamızı istemiyorsanız bu mesaja 'istemiyorum' yazarak cevap verebilirsiniz.<br>"

evn.Save
'evn.display
evn.send
strresmim = vbNullString
Set evn = Nothing: Set objOlk = Nothing: Set objevn = Nothing: Set objEkle = Nothing: evngovde = vbNullString: Set ek = Nothing
End If
Rows(1).Delete
x = x + 1
If x <> 5 Then GoTo 10
'Buradaki 5 rakamı gönderilecek mail miktarını belirler. Siz 100 yazarsanız 100 tane gönderir.

MsgBox "İşlem Tamam Patron", vbInformation
ThisWorkbook.Save
Application.EnableCancelKey = xlInterrupt
End Sub
 
hamitcan' Alıntı:
Renklendirilmiş kısımlara dikkat ediniz. Kod, mail atma işlemi bittikten sonra ilk yüz satırı silip durur.
Kod: 
Sub gonder()
Application.ScreenUpdating = False
On Error Resume Next
Dim ek As Object
Dim objOlk As Object, evn As Object, strresmim
Dim objEkle As Object, objevn As Object, evngovde As String
Rem Www.ExcelVBA.Net - 29.06.2010 - Tarkan VURAL
Dim Hlink

Dim firma
aa = [b65536].End(3).Row
If aa = "" Then
Exit Sub
End If
For h = 1 To [color=red]100[/color]
If Application.Wait(Now + TimeValue("0:00:08")) Then

firma = Range("b" & h)
strresmim = Range("h" & h) & ".jpg"
    Set objOlk = CreateObject("Outlook.Application")
    Set evn = objOlk.CreateItem(0)
    evn.To = Range("f" & h)
    evn.Subject = Range("g" & h)
            evngovde = "<br></br>" & "<a></a>" & _
        Range("c" & h) & " " & "Yeni Yılda Yine <b> Kurumsal Market </b>" & _
    "<br><br>*******Yeni Yılda Kartuş Toner ve Şerit İhtiyaçlarınız İçin Size Yepyeni Bir Fırsat" & _
    "<br>*******En Ucuz Fiyatlarla Tekrar Karşınızdayız" & _
    "<br>*******Kargo <b>SADECE 1,00 TL</b>" & _
    "<br></br>" & _
    "<br>*******Satın aldığınız her ürün adınıza faturalı olarak kapınıza gelir ve beğeninize sunulur.<br>" & _
    "<br>       <br>" & _
    "<br><b>En Güvenli Ödeme Şekilleri :</b><br>" & _
    "******-*Kapıda Ödeme<br>" & _
    "******-*Kredi Kartı İle Ödeme<br>" & _
    "******-*Hesaba Havale<br>"
        Set objEkle = evn.Attachments
        Set objevn = objEkle.Add(strresmim)
        evn.Close olSave
        evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
        strresmim & "'' align=baseline border=0><br></BODY>"
        evn.HTMLBody = evngovde & "<br><IMG alt='' hspace=0 src='cid:'" & _
        strresmim & "'' align=baseline border=0><br></BODY>" & _
            "<br><br>Erman USTA<br>" & _
            "<b>Satış Temsilcisi</b><br>" & _
            "0532 341 12 19<br><br>" & _
            "<b>Online Sipariş için: www.KURUMSALmarket.com</b><br>" & _
                "<br>       <br>" & _
            Range("c" & h) & " " & "*******Müşterilerimiz için ve verdileri referanslar doğrultusunda hazırladığımız bu mail, sizin daha iyi şartlar altında çalışmanızı sağlamak amacı ile gönderilmiştir. Eğer size yardımcı olmamızı istemiyorsanız bu mesaja 'istemiyorum' yazarak cevap verebilirsiniz.<br>"
    evn.Save
    evn.send
strresmim = vbNullString
Set evn = Nothing: Set objOlk = Nothing
Set objevn = Nothing: Set objEkle = Nothing
evngovde = vbNullString: Set ek = Nothing
'Tarih = Now + TimeValue("00:0:04")
'Application.OnTime Tarih, "gonder"
End If
Next h
[color=red]rows("1:100").delete[/color]
'Application.ScreenUpdating = True
'Tarih = Now + TimeValue("00:0:04")
'Application.OnTime Tarih, "gonder"
End Sub
Genişletmek için tıkla ...

Hamit Bey,
YUkarıdaki kodlarınız outlook kapalı olsa bile çalışıyor. Ancak ben aşağıdaki kodlar ile outlook kapalı iken çalıştırmadım. (Açık iken Çalışıyor) Yardımıcı olur musunuz?
Kod: 
Sub Makromail()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

On Error Resume Next

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

With OutMail
.To = "ornek@ornek.com"
.CC = ""
.BCC = ""
.Subject = "DENEME 1 - " & i & " Tarih : " & Date
'.Attachments.Add ""
'.HTMLBody = ""
.body = "denemdir"
'.Display  'Outlook görünmeden göndermek için
'.Save
.send 'maili göndermek için
End With

On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
Set rng = Nothing

End Sub
 
Sorunuzu anlayamadım ayrıca kodlar bana ait değil, ben sadece koda bir eklenti yapmışım.
 
doganbaris' Alıntı:
başka siteden bir kodu alıp, bu siteye gelip güncellettmek ?

anlayamadım....
Genişletmek için tıkla ...
Sayın doganbaris, bizim böyle katı kurallarımız yok. Kodlar açık bir şekilde verildiği sürece sorun yok demektir. Sadece, en azından yazan kişiye bir teşekkürü eksik etmemeliyiz.
 
hamitcan' Alıntı:
Sorunuzu anlayamadım ayrıca kodlar bana ait değil, ben sadece koda bir eklenti yapmışım.
Genişletmek için tıkla ...
Hamit bey,
üstteki kodlar ile outlook programı kapalı olsa bile, mail gönderiliyor.
aşağıdaki kendime uyarladığım kodlar ile outlook programı kapalı iken gitmiyor. Ancak outlook programını açarsan gidiyor. Nerede ne eksiği var? Bunu soruyorum.
 
Açıkcası iki kod arasında bir fark göremedim ama hataları görmemizi engelleyen satırları kaldırdım, bir de bu şekilde deneyin.

Kod: 
Sub Makromail()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

On Error Resume Next



Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)



With OutMail
.To = "ornek@ornek.com"
.CC = ""
.BCC = ""
.Subject = "DENEME 1 - " & i & " Tarih : " & Date
'.Attachments.Add ""
'.HTMLBody = ""
.body = "denemdir"
'.Display  'Outlook görünmeden göndermek için
'.Save
.send 'maili göndermek için
End With





Set OutMail = Nothing
Set OutApp = Nothing
Set rng = Nothing

End Sub
 
Denedim. Outlook kapalı iken mail gitmiyor. Açık iken gidiyor.
Ama sizin kodlarınız kapalı iken de gidiyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst