Merhaba Arkadaşlar,

Uzun bir süreden beridir foruma uğrayamadım. Soru sormanın mutluluğu ile bir problemimi sizlerle paylaşmak istiyorum.

Ekteki excel dosyamda herşeyi anlattım. Excele girilen bilgileri satır satır ilgili mail adreslerine göndermek istiyorum. Bunun için nasıl bir çözüm yapabileceğimize dair yardımcı olan üstadlar olursa sevinirim. Bu konu beni aşıyor.

Saygılarımla,

Kimsenin dikkatini çekmedi sanırım problemim.

Sn mengene;
modul ıcıne kodu tasiyin ve bir dugmeye olay yordamina call Postala ile liste sonuna kadar posta gonderebilirsiniz. Access ile bagli tablo ile de yapilabilir.
Sub Postala()
Const Eadresim As String = "mengene@gmail.com"
Dim Posta As Outlook.Application
Dim Mesaj As Outlook.MailItem
Dim SayfaM As Outlook.Recipient
Dim Sayac As Long
For Sayac = 2 To Cells.Find(What:="@", After:=Cells(Rows.Count, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set Posta = CreateObject("Outlook.Application")
Set Mesaj = Posta.CreateItem(olMailItem)
With Mesaj
Set SayfaM = .Recipients.Add(Sheets("Sayfa1").Range("C" & Sayac))
SayfaM.Type = olTo
.Subject = "İş Görüşmesi"
.HTMLBODY = "<div style='position:absolute;top:0px;left:0px;width:50px;height:82px;font-size:25px;font-family:Arial,georgia;color:#000000' align='left' TextWrapping='Wrap'>" & _
"<p>Merhaba Sayın <b>" & Sheets("Sayfa1").Range("B" & Sayac) & " </b></p>" & _
"Sizlerle yaptığımız iş görüşmesi <b>" & Sheets("Sayfa1").Range("F" & Sayac) & " " & Sheets("Sayfa1").Range("D" & Sayac) & "</b> olarak değerlendirilmiştir.</p>" & _
"<p>A Firmasını Tercih ettiğiniz için teşekkürlerimizi sunarız.</p></div>" & _
"<div style='color:#FFFFFF'<p>.</p>" & _
"<p>.</p></div>" & _
"<div style='font-size:25px;font-family:Arial,georgia;color:#000000'<p><b><a href='#" & Eadresim & "'>İK Departmanı</a></b></p></div>"
For Each SayfaM In .Recipients
SayfaM.Resolve
If Not SayfaM.Resolve Then
Exit Sub
End If
Next
.Send
End With
Next Sayac
End Sub

Merhaba,
Aşağıdaki kodda sadece hücrelerin kordinatlarını belirtmen yeterli.Her butonda da kordinatları güncellemen gerekli.Ben örnek olsun diye Sayfa1.Cells(2, 1),Sayfa1.Cells(2, 3),Sayfa1.Cells(2, 2) hücrelerin kordinatlarını verdim.Yapman gereken bu.


Sub Mail_Workbook_1()

Dim OutApp As Object
Dim OutMail As Object


Set OutApp = CreateObject("Outlook.Application")

On Error Resume Next

Set OutMail = OutApp.CreateItem(0)


With OutMail


.To = Sayfa1.Cells(2, 1)
.CC = ""
.BCC = ""
.Subject = Sayfa1.Cells(2, 3)
.Body = Sayfa1.Cells(2, 2)
.Attachments.Add
.Send

End With

On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

End Sub