Kimden seçeneğine göre mail gönderme

[ozuberk]

Merhaba arkadaşlar aşağıdaki kodu kullanarak toplu mail gönderimi yapıyorum. Aşağıdaki koda Outlook’ta tanımlı olan kimden mail adresine göre gönderim yapmak mümkün müdür?


Sub MAIL_GONDER()
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Dim SigString As String
Dim Signature As String
Dim S1 As Worksheet, X As Long

Set Outlook_App = CreateObject("Outlook.Application")
Set S1 = Sheets("Sheet1")

SigString = Environ("appdata") & _
"/Microsoft/Signatures/imza.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next


For X = 2 To S1.Cells(S1.Rows.Count, 1).End(3).Row
Set Outlook_Mail = Outlook_App.CreateItem(0)
With Outlook_Mail
.To = S1.Cells(X, 2)
.CC = ""
.Subject = Range("F1") & " [" & S1.Cells(X, 1) & "]"
'.body = Range("G2")
.HTMLBody = "<br>" & Range("F2") & "<br>" & "<br>" & Range("F4") & "<br>" & Range("F6") & "<br>" & Signature
.Attachments.Add S1.Cells(X, 3).Text
.BodyFormat = 2
.Save
'.Send
.Display
End With
Next

Set S1 = Nothing
Set Outlook_Mail = Nothing
Set Outlook_App = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

 

[Korhan Ayhan]

Linklerde bazı bilgiler var.

Mailin Hangi Adresten Gönderileceğini Belirlemek

Arkadaşlar merhaba, Youtube 'da yer alan videolarla dosyayı pdf olarak kaydetme ve mail olarak gönderme makrolarını çalışmama uyarladım. Fakat outlook'ta 2 mail adresi kurulu olduğundan ben birisini sadece excelden mail gönderirken kullanmak istiyorum. Mailin gönderileceği adresi nasıl sabit...

www.excel.web.tr

Mail Gövdesine Tablodan Ayrı Ayrı Bölümleri Alma

Merhaba Arkadaşlar, Aşağıdaki konu hakkında yardımınıza ihtiyacım var. Mail ekinde gönderdiğim excel tablosunda dikkat ettiyseniz 3 birime ait personellerim var. Ben istiyorum ki Outlook 3 ayrı mail hazırlasın ve her birimin personellerini başlıkla birlikte kopyalayıp mail gövdelerine...

www.excel.web.tr

 

[ozuberk]

Korhan bey bilgi için teşekkür ederim. Aşağıya örnek olması için kodu ekliyorum.

'____________________________________________________________________________________________________________________________________________________________
Option Explicit

Sub Mail_Gonder()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Toplu Email")
Dim i As Integer

Dim OA As Object
Dim msg As Object

Set OA = CreateObject("outlook.application")

Dim last_row As Integer
last_row = sh.Range("D" & Application.Rows.Count).End(xlUp).Row

For i = 6 To last_row

If UCase(sh.Range("A" & i).Value) <> "EVET" Then

Set msg = OA.createitem(0)

If sh.Range("C" & i).Value <> "" Then msg.SentOnBehalfOfName = sh.Range("C" & i).Value


msg.To = sh.Range("D" & i).Value
msg.cc = sh.Range("E" & i).Value
msg.Subject = sh.Range("F" & i).Value
msg.body = sh.Range("G" & i).Value

If sh.Range("H" & i).Value <> "" Then
msg.attachments.Add sh.Range("H" & i).Value
End If

If sh.Range("I" & i).Value <> "" Then
msg.attachments.Add sh.Range("I" & i).Value
End If

If sh.Range("J" & i).Value <> "" Then
msg.attachments.Add sh.Range("J" & i).Value
End If

If sh.Range("K" & i).Value <> "" Then
msg.attachments.Add sh.Range("K" & i).Value
End If

If sh.Range("A1").Value = 1 Then
msg.send
Else
msg.display
End If

sh.Range("B" & i).Value = "Tamamlandı"

End If

Next i

MsgBox "Mail Gönderme İşlemi Tamamlandı!!!", vbInformation

End Sub

'____________________________________________________________________________________________________________________________________________________________
Sub Ek_Dosya_Yolunu_Sec()

Dim file_path As String
file_path = Application.GetOpenFilename(MultiSelect:=False)
If file_path <> "False" Then
Selection.Value = file_path
End If

End Sub