• DİKKAT

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

1.sayfadaki mail adreslerine 2.sayfadaki HTML kodu gönderme

E

ermanusta

Katılım
18 Nisan 2008
Mesajlar
304
Excel Vers. ve Dili
excel 365
Office 365
Merhaba,
mevcut müşterilerime düzenli olarak bilgilendirme mail göndermek için yapmak istediğim bir program var



ekte bir dosya mevcut,
bu dosyada 2 sayfa var

birinci sayfada A stünunda mail adresleri var
ikici sayfada A1:A870 aralığında bir HTML kodu var



yapmam gereken;

-birinci sayfadaki a1 hücresindeki mail adresine b1 hücresindeki konu ile ikinci sayfadaki HTML kodunun tamamını göndermek
-gönderdikten sonra gönderdiği mail hücresini silecek ve kayıt edecek
-kayıttan 10 saniye sonra işlemi başa alacak
-döngüyü 100 kere yaptıktan sonra dosyayı kayıt edip duracak

bu şekilde bir kodu aradım ancak bulamadım,
 

Ekli dosyalar

Son düzenleme:
konu güncel arkadaşlar, hala çözüm bulabilmiş değilim,
lütfen yardım edin.
 
ermanusta' Alıntı:
konu güncel arkadaşlar, hala çözüm bulabilmiş değilim,
lütfen yardım edin.
Genişletmek için tıkla ...

WORD kullanarak, liste olarak belirlenen maillere word deki bir belgeyi mail olarak gönderebilirsin. Mail listesinin olduğu dosyadaki belirli alanları, belge içinde değişken olarak da kullanabilirsin.

Mutlaka excel ile çözülmesi gerekmiyor ise bu şekilde sorunu çözebilir siniz?
 
asri' Alıntı:
WORD kullanarak, liste olarak belirlenen maillere word deki bir belgeyi mail olarak gönderebilirsin. Mail listesinin olduğu dosyadaki belirli alanları, belge içinde değişken olarak da kullanabilirsin.

Mutlaka excel ile çözülmesi gerekmiyor ise bu şekilde sorunu çözebilir siniz?
Genişletmek için tıkla ...


100 den fazla mail adresi var
html kodunu ek olarak değil direk içerik olarak gönderip görsel bir tanıtım bilgilendirme yapmam gerekiyor. word de bu şekilde bir olayın olduğunu bilmiyorum. excellde elimde çalışan bir makro var ancak içerisine html kodunu giremiyorum.
 
biraz baktım word de böyle birşey var ancak zamanlama yapamıyorum. şöyleki, bir kişiye mail gönderdikten sonra 10 saniye bekleyip ikinci kişiye mail gönderemiyorum. nedeni 100 den fazla mail gönderdiğimde sunucuda sıkışma yapıyor ve hosting firmam spam olarak değerlendiriyor. bu yüzden her 10 saniyede bir mail göndermem gerekiyor.
 
şöyle bir makro buldum acaba bunu her 10 saniyede bir mail gönderecek şekilde ayarlayabilirmiyiz?
ve hangi mail listesine uyarlıyacağız ?
 
Şu kodu dener misiniz?

Kod: 
Sub sendEmail()
Dim myOutlook As Outlook.Application, myEmail(100) As Outlook.MailItem, myEmailBody As String, r1 As Variant
Set myOutlook = GetObject(, "Outlook.Application")
If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


r1 = Sheets("html").Range("A1:A870")

For i = 1 To UBound(r1)
myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
Next

For i = 1 To 100
If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
Set myEmail(i) = myOutlook.CreateItem(olMailItem)
myEmail(i).Importance = olImportanceNormal
myEmail(i).Subject = Sheets("mail adresleri").Cells(1, 2)
myEmail(i).Body = myEmailBody
myEmail(i).Recipients.Add Sheets("mail adresleri").Cells(1, 1)
myEmail(i).Send
Sheets("mail adresleri").Rows(1).Delete
ThisWorkbook.Save
Application.Wait (Now + TimeValue("0:00:10"))
Next



End Sub
 
ayhanfuat' Alıntı:
Şu kodu dener misiniz?

Kod: 
Sub sendEmail()
Dim myOutlook As Outlook.Application, myEmail(100) As Outlook.MailItem, myEmailBody As String, r1 As Variant
Set myOutlook = GetObject(, "Outlook.Application")
If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


r1 = Sheets("html").Range("A1:A870")

For i = 1 To UBound(r1)
myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
Next

For i = 1 To 100
If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
Set myEmail(i) = myOutlook.CreateItem(olMailItem)
myEmail(i).Importance = olImportanceNormal
myEmail(i).Subject = Sheets("mail adresleri").Cells(1, 2)
myEmail(i).Body = myEmailBody
myEmail(i).Recipients.Add Sheets("mail adresleri").Cells(1, 1)
myEmail(i).Send
Sheets("mail adresleri").Rows(1).Delete
ThisWorkbook.Save
Application.Wait (Now + TimeValue("0:00:10"))
Next



End Sub
Genişletmek için tıkla ...


Ayhan Bey,
outlook 2010 u kullanıyorum. Office 2010 türkçe kullanıyorum.
sanırım app hatası alıyorum
"myOutlook As Outlook.Application"
 
Son düzenleme:
VBA penceresinde Tools - References altından Microsoft Outlook 14.0 Object Library'yi seçip dener misiniz bir de? Outlook açık olmalı bu arada makroyu çalıştırırken.
 
ayhanfuat' Alıntı:
VBA penceresinde Tools - References altından Microsoft Outlook 14.0 Object Library'yi seçip dener misiniz bir de? Outlook açık olmalı bu arada makroyu çalıştırırken.
Genişletmek için tıkla ...

evet bu şekilde oldu,
ancak görsel olarak hazırlanan html kodu yazı şeklinde çıkıyor. bu html kodunu bir iletinin kodu olarak algılaması gerek
 
Bir de böyle deneyin.

Kod: 
Sub sendEmail()
Dim myOutlook As Outlook.Application, myEmail(100) As Outlook.MailItem, myEmailBody As String, r1 As Variant
Set myOutlook = GetObject(, "Outlook.Application")
If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


r1 = Sheets("html").Range("A1:A870")

For i = 1 To UBound(r1)
myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
Next

For i = 1 To 100
If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
Set myEmail(i) = myOutlook.CreateItem(olMailItem)
myEmail(i).Importance = olImportanceNormal
myEmail(i).Subject = Sheets("mail adresleri").Cells(1, 2)
myEmail(i).BodyFormat = olFormatHTML
myEmail(i).HTMLBody = myEmailBody
myEmail(i).Recipients.Add Sheets("mail adresleri").Cells(1, 1)
myEmail(i).Send
Sheets("mail adresleri").Rows(1).Delete
ThisWorkbook.Save
Application.Wait (Now + TimeValue("0:00:10"))
Next



End Sub
 
ayhanfuat' Alıntı:
Bir de böyle deneyin.

Kod: 
Sub sendEmail()
Dim myOutlook As Outlook.Application, myEmail(100) As Outlook.MailItem, myEmailBody As String, r1 As Variant
Set myOutlook = GetObject(, "Outlook.Application")
If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


r1 = Sheets("html").Range("A1:A870")

For i = 1 To UBound(r1)
myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
Next

For i = 1 To 100
If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
Set myEmail(i) = myOutlook.CreateItem(olMailItem)
myEmail(i).Importance = olImportanceNormal
myEmail(i).Subject = Sheets("mail adresleri").Cells(1, 2)
myEmail(i).BodyFormat = olFormatHTML
myEmail(i).HTMLBody = myEmailBody
myEmail(i).Recipients.Add Sheets("mail adresleri").Cells(1, 1)
myEmail(i).Send
Sheets("mail adresleri").Rows(1).Delete
ThisWorkbook.Save
Application.Wait (Now + TimeValue("0:00:10"))
Next



End Sub
Genişletmek için tıkla ...

teşekkür ederim bu şekilde istediğim gibi oldu.
ancak nedenini anlamadığım bir sorun var. tarayıcıda çok düzgün görülen html görsel kaynak mail gönderdiğimde outlookta çok karışık ve bozuk çıkıyor. html dilinden çok iyi anlamam ama acaba nedeni ne olabilir. versiyon geldi aklıma ama...
 
ayhanfuat' Alıntı:
Bir de böyle deneyin.

Kod: 
Sub sendEmail()
Dim myOutlook As Outlook.Application, myEmail(100) As Outlook.MailItem, myEmailBody As String, r1 As Variant
Set myOutlook = GetObject(, "Outlook.Application")
If myOutlook Is Nothing Then Set myOutlook = New Outlook.Application


r1 = Sheets("html").Range("A1:A870")

For i = 1 To UBound(r1)
myEmailBody = myEmailBody & r1(i, 1) & vbCrLf
Next

For i = 1 To 100
If Sheets("mail adresleri").Cells(1, 1) = "" Then Exit For
Set myEmail(i) = myOutlook.CreateItem(olMailItem)
myEmail(i).Importance = olImportanceNormal
myEmail(i).Subject = Sheets("mail adresleri").Cells(1, 2)
myEmail(i).BodyFormat = olFormatHTML
myEmail(i).HTMLBody = myEmailBody
myEmail(i).Recipients.Add Sheets("mail adresleri").Cells(1, 1)
myEmail(i).Send
Sheets("mail adresleri").Rows(1).Delete
ThisWorkbook.Save
Application.Wait (Now + TimeValue("0:00:10"))
Next



End Sub
Genişletmek için tıkla ...



Ayhan bey makro çok güzel çalışıyor bir sorun yok, ancak HER SAAT BAŞI DURUYOR hata veriyor nedeni ne olabilir acaba ?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst