- Katılım
- 27 Ocak 2011
- Mesajlar
- 307
- Excel Vers. ve Dili
- 2016-Excel (Türkçe)
- Altın Üyelik Bitiş Tarihi
- 10-09-2024
Merhaba;
Forumdaki bir örnekden aşağıdaki şekilde mail gönderme kodu buldum.Benim sorum şu olacak.Bu kodla ilgili alanlara giriş yapıldığında otomatik mail gönderiliyor.Fakat tüm adresleri To kısmına ekliyor.Aynı anda Cc kısmına da adres eklemek için kodu nasıl revize edebilirim.
Saygılarımla.
Sub Mail_Gonder()
Dim i As Long, _
j As Integer, _
d, _
Adet As Integer, _
msg As String, _
HLink As String, _
Recipient As String, _
Subj As String
' Ron de Bruin
For i = 3 To Cells(Rows.Count, "A").End(3).Row
If IsEmpty(Cells(i, "D")) = False And Cells(i, "E") Like "*@*" Then
Subj = "Güvenlik yardım masası - Olay bildirim formu"
msg = Cells(i, "A") & "%0A"
msg = msg & "%0A" & "Olay başlanıç : " & Cells(i, "B")
msg = msg & "%0A" & "Olay bitiş : " & Cells(i, "C")
msg = msg & "%0A" & "%0A" & "%0A" & "securitycontrolroom@tescokipa.com.tr"
d = Split(Cells(i, "E"), ";")
For j = 0 To UBound(d)
Adet = Adet + 1
Recipient = d(j)
HLink = "mailto:" & Recipient & "?"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg
ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%s", True
Next j
End If
Next
End Sub
Forumdaki bir örnekden aşağıdaki şekilde mail gönderme kodu buldum.Benim sorum şu olacak.Bu kodla ilgili alanlara giriş yapıldığında otomatik mail gönderiliyor.Fakat tüm adresleri To kısmına ekliyor.Aynı anda Cc kısmına da adres eklemek için kodu nasıl revize edebilirim.
Saygılarımla.
Sub Mail_Gonder()
Dim i As Long, _
j As Integer, _
d, _
Adet As Integer, _
msg As String, _
HLink As String, _
Recipient As String, _
Subj As String
' Ron de Bruin
For i = 3 To Cells(Rows.Count, "A").End(3).Row
If IsEmpty(Cells(i, "D")) = False And Cells(i, "E") Like "*@*" Then
Subj = "Güvenlik yardım masası - Olay bildirim formu"
msg = Cells(i, "A") & "%0A"
msg = msg & "%0A" & "Olay başlanıç : " & Cells(i, "B")
msg = msg & "%0A" & "Olay bitiş : " & Cells(i, "C")
msg = msg & "%0A" & "%0A" & "%0A" & "securitycontrolroom@tescokipa.com.tr"
d = Split(Cells(i, "E"), ";")
For j = 0 To UBound(d)
Adet = Adet + 1
Recipient = d(j)
HLink = "mailto:" & Recipient & "?"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg
ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%s", True
Next j
End If
Next
End Sub