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

ermanusta · 9 Ocak 2013

Makrolar konusunda çok yeniyim, pek bişey bilmiyorum araştırarak öğrenmeye çalışıyorum ama neyi bile araştırdığımı bilmediğim bişeyi bulması zor oluyor

aşşağıdaki gibi bir makrom var elimde

-bu şekilde başlayan

Dim firma
aa = [b2].End(2).Row
If aa = "" Then
Exit Sub
End If
For h = 2 To aa
firma = Range("b" & h)
.
.
.
.

Next h
Application.ScreenUpdating = True
Tarih = Now + TimeValue("00:0:08")
Application.OnTime Tarih, "gonder"
End Sub

bu şekilde son bulan.Bu makro her 8 saniyede bir çalışıyor ve işlevi satırda bulunan bilgileri mail atmak. ama her başladığında baştan alıyor ve hep aynı satır için çalışıyor

yapmak istediğim bu makro ilk çalıştığında 1. satır için işlem yapsın
sonra 2-3-4-5-6.....100 de son bulsun.her maili 8 saniyelik aralıklarla göndersin ve macro ilk 100 maili gönderdikten sonra gönderdiği mail satırlarını silsin. tekrar çalıştırıldığında ikinci 100 mail için aynı işlemi yapsın istiyorum

bunu nasıl yapabilirim. isteyen olursa örnek dosyayıda ekleyebilirim makronun tamamınıda ekleyebilirim..

hamitcan · 9 Ocak 2013

Bence dosyanızı da ekleyin.

ermanusta · 9 Ocak 2013

hamitcan' Alıntı:
Bence dosyanızı da ekleyin.

Hamit bey Örnek dosyayı ekledim, macro içerisinde mevcut

hamitcan · 9 Ocak 2013

Bu şekilde dener misiniz ?

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 aa
[color=red]If Application.Wait(Now + TimeValue("0:00:08")) Then[/color]

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
'Application.ScreenUpdating = True
'Tarih = Now + TimeValue("00:0:04")
'Application.OnTime Tarih, "gonder"
End Sub

ermanusta · 9 Ocak 2013

hamitcan' Alıntı:

Bu şekilde dener misiniz ?

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 aa
[color=red]If Application.Wait(Now + TimeValue("0:00:08")) Then[/color]

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
'Application.ScreenUpdating = True
'Tarih = Now + TimeValue("00:0:04")
'Application.OnTime Tarih, "gonder"
End Sub

denedim ancak sadece ilk maili gönderip duruyor. ikinci üçüncü maillere ve sonrasına gitmiyor.

ermanusta · 9 Ocak 2013

hatta şunu diyebilirim,
macro verdiğimiz süre kadar bekledikten sonra çalışıyor.

hamitcan · 9 Ocak 2013

Galiba bu satırla ilgili.

Kod:

aa = [b65536].End(3).Row

Şu şekilde değiştirip deneyiniz.

Kod:

aa = [[color=red]f[/color]65536].End(3).Row

ermanusta · 9 Ocak 2013

son gönderdiğiniz düzeltme ile tam olarak 8 saniyede bir bir sonraki mail adresine mail atıyor.çok güzel oldu.

acaba ilk 100 satır sonunda durup attığı 100 mail adres satırını silebilirmi makro?
yoksa zor olur ise elle yapabilirim ama bu işlemi sanırım 250 kere yapmam gerekebilir..

hamitcan · 9 Ocak 2013

Mail adresi içeren satırlar 100 den fazla mı ?

hamitcan · 9 Ocak 2013

Silinen bu mail adreslerini tekrar oluşturacak mısınız ?

ermanusta · 9 Ocak 2013

hamitcan' Alıntı:
Mail adresi içeren satırlar 100 den fazla mı ?

evet bu mail adresleri ortalama 20.000 civarında
tekrar oluşturmak gibi bir makro ile uğraşmıyayım diye, her seferinde bu mail adreslerini içeren bir kopya excell dosyası kullanacağım.
her dosyadaki mail adreslerine mail gönderdikten sonra içerisinde bir çok mail adresi silindiği için tekrar kullanılamaz hale gelir. bende bu dosyaları komple sileceğim. devamında yeni bir kopya adresle bu işlemi tekrarlayacağım.niyetindeyim.

hamitcan · 9 Ocak 2013

Her defasında 100 mail gönderecekseniz, döngünün bitimini 100 olarak ayarlayabilir sonra da bu 100 satırı silebiliriz.

ermanusta · 9 Ocak 2013

tamam aynenböyle olmasını istiyorum,
her döngüde 100 mail
her döngü sonunda bu satırlar silinsin.

hamitcan · 9 Ocak 2013

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

ermanusta · 9 Ocak 2013

Allah razı olsun çok güzel oldu.
lakin bilmiyorum fazlamı oluyorum ama bilmeyebilirsiniz diye sormamıştım. bu mail göndermede herhangibir yazı yada resim üzerine link veremedim ben siz bilirmisiniz acaba?

hamitcan · 9 Ocak 2013

ermanusta' Alıntı:
Allah razı olsun çok güzel oldu.
lakin bilmiyorum fazlamı oluyorum ama bilmeyebilirsiniz diye sormamıştım. bu mail göndermede herhangibir yazı yada resim üzerine link veremedim ben siz bilirmisiniz acaba?

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

ermanusta · 9 Ocak 2013

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

yardımlarınız için çok teşekkür ederim, Allah yolunuzu açık etsin. iyi çalışmalar

ermanusta · 12 Ocak 2013

Hamit bey,
Makroda ufak bir değişiklik yapmak gerekiyor. Bazi sorunlar cikti.

Her 100 mailden sonra 100 satiri silmek yerine. Her attigi maili attiktan hemen sonra silmesi gerekiyor. Ama tabi 8 saniye araliklarla 100 mail atmasi döngüsü sabit kalmali.

Rica etsem böyle bir düzenleme yapabilir misiniz?

ermanusta · 12 Ocak 2013

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
End If
Next h

döngü arasına bulduğum bu kodu girdim deneme yanılmayla oldu sanırım. işimi görüyor.

ermanusta · 13 Ocak 2013

olmadı bu şekilde hatalı oluyor.

1. satır maili gönderiyor
2. satır göndermiyor
3. satır maili gönderiyor
4.satır göndermiyor

yanlış bir döngü oldu. doğrusunu siz yazabilrmisiniz

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

ermanusta

Ekli dosyalar

hamitcan

Uzman

ermanusta

hamitcan

Uzman

ermanusta

ermanusta

hamitcan

Uzman

ermanusta

hamitcan

Uzman

hamitcan

Uzman

ermanusta

hamitcan

Uzman

ermanusta

hamitcan

Uzman

ermanusta

hamitcan

Uzman

ermanusta

ermanusta

ermanusta

ermanusta