Otomatik Mail Gönderme

M

magenta

Katılım
16 Mayıs 2017
Mesajlar
9
Excel Vers. ve Dili
2010, türkçe
Altın Üyelik Bitiş Tarihi
22.05.2022
Merhaba arkadaşlar, excelden belli şartlara göre otomatik mail gönderiyorum. Ancak bazı hücrelerdeki veriler çok önemli olduğu için mail gövdesinde onları kalın ya da italik göstermek istiyorum. Kod aşağıdaki gibi mail gösdesi de ekteki gibidir. Ekteki ekran alındısında sarı arka planlı yerleri boldlamak istersem nasıl yaparım acaba? Bu sarı arka planlı yerler excelden çekiliyor. Yardımlarınız için şimdiden teşekkür ederim....

saydir = Cells(Rows.Count, "G").End(xlUp).Row 'G sütununun son satirinı bulur
For i = 4 To saydir
If Range("P" & i) = "" And Date <= Range("M" & i) And Date >= Range("K" & i) Then

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.Display
.To = Range("S" & i)
.CC = Range("T" & i)
.BCC = ""
.Subject = "Uygunsuzluk ve Düzeltici Faaliyet Takibi"
.Body = "Merhaba," & vbCrLf & vbCrLf & Range("G" & i) & " uygunsuzluğunun/iyileştirme faaliyetinin " & Range("M" & i) & " tarihinde kapatılması gererkmektedir. " & vbCrLf & vbCrLf & "Gerçekleştirilecek faaliyetin son durumu hakkında lütfen Yönetim Temsilcisine bilgi veriniz! " & vbCrLf & vbCrLf & "Bu mail hatırlatma amacıyla gönderilmiştir."
'.Send 'or use
.Display
End With
On Error GoTo 0
 

Ekli dosyalar

K

Kekoli

Altın Üye
Katılım
4 Aralık 2017
Mesajlar
134
Excel Vers. ve Dili
Excell 2016
Altın Üyelik Bitiş Tarihi
11-02-2025
hocam bir çözüm bulabildiniz mi?
ben de aynı dertten müzdaribim.
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
.body yerine deneyiniz.

Kod: 
.htmlbody="<b>This text is bold</b><br/><span style=""color:#80BFFF"">Font Color</span style=""color:#80BFFF""><br />" & _
               "<u>New line with underline</u><br /><p style='font-family:calibri;font-size:25'>Font size</p>"
 
M

magenta

Katılım
16 Mayıs 2017
Mesajlar
9
Excel Vers. ve Dili
2010, türkçe
Altın Üyelik Bitiş Tarihi
22.05.2022
merhaba hocam, bunu kodun tam neresine koyacağım???
 
K

Kekoli

Altın Üye
Katılım
4 Aralık 2017
Mesajlar
134
Excel Vers. ve Dili
Excell 2016
Altın Üyelik Bitiş Tarihi
11-02-2025
.body kısmını komple bununla değiştireceksin sanırım,
renkli, altı çizili, kalın vb. metinler çıkarak sana,
oradan kendi metnine tekrar uyarlaman gerekecek muhtemelen.
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Kekoli' Alıntı:
.body kısmını komple bununla değiştireceksin sanırım,
renkli, altı çizili, kalın vb. metinler çıkarak sana,
oradan kendi metnine tekrar uyarlaman gerekecek muhtemelen.
Genişletmek için tıkla ...
Doğrudur, tarif ettiğiniz gibi.
 
M

magenta

Katılım
16 Mayıs 2017
Mesajlar
9
Excel Vers. ve Dili
2010, türkçe
Altın Üyelik Bitiş Tarihi
22.05.2022
saydir = Cells(Rows.Count, "G").End(xlUp).Row 'G sütununun son satirinı bulur
For i = 4 To saydir
If Range("P" & i) = "" And Date <= Range("M" & i) And Date >= Range("K" & i) Then

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.Display
.To = Range("S" & i)
.CC = Range("T" & i)
.BCC = ""
.Subject = "Uygunsuzluk ve Düzeltici Faaliyet Takibi"
.Body = "Merhaba," & vbCrLf & vbCrLf & Range("G" & i) & " uygunsuzluğunun/iyileştirme faaliyetinin " & Range("M" & i) & " tarihinde kapatılması gererkmektedir. " & vbCrLf & vbCrLf & "Gerçekleştirilecek faaliyetin son durumu hakkında lütfen Yönetim Temsilcisine bilgi veriniz! " & vbCrLf & vbCrLf & "Bu mail hatırlatma amacıyla gönderilmiştir."
.htmlbody="<b>This text is bold</b><br/><span style=""color:#80BFFF"">Font Color</span style=""color:#80BFFF""><br />" & _
"<u>New line with underline</u><br /><p style='font-family:calibri;font-size:25'>Font size</p>"

'.Send 'or use
.Display
End With
On Error GoTo 0

Böyle olunca olmuyor arkadaşlar, nasıl bir yazımı kastettiğinizi kod üzerinden gönderebilir misiniz?
 
K

Kekoli

Altın Üye
Katılım
4 Aralık 2017
Mesajlar
134
Excel Vers. ve Dili
Excell 2016
Altın Üyelik Bitiş Tarihi
11-02-2025
saydir = Cells(Rows.Count, "G").End(xlUp).Row 'G sütununun son satirinı bulur
For i = 4 To saydir
If Range("P" & i) = "" And Date <= Range("M" & i) And Date >= Range("K" & i) Then

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.Display
.To = Range("S" & i)
.CC = Range("T" & i)
.BCC = ""
.Subject = "Uygunsuzluk ve Düzeltici Faaliyet Takibi"
.htmlbody="<b>This text is bold</b><br/><span style=""color:#80BFFF"">Font Color</span style=""color:#80BFFF""><br />" & _
"<u>New line with underline</u><br /><p style='font-family:calibri;font-size:25'>Font size</p>"

'.Send 'or use
.Display
End With
On Error GoTo 0
 
M

magenta

Katılım
16 Mayıs 2017
Mesajlar
9
Excel Vers. ve Dili
2010, türkçe
Altın Üyelik Bitiş Tarihi
22.05.2022
Hocam, html hiç bilmiyorum, bu kodun içinde benim gövdeye yazacağım metin yok. Gövde aynen aşağıdaki gibi çıkıyor mailde... Benim bodyi bu htmlin içinde bir yerlere mi koymam lazım?
This text is bold
Font Color
New line with underline
Font size
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
magenta' Alıntı:
Hocam, html hiç bilmiyorum, bu kodun içinde benim gövdeye yazacağım metin yok. Gövde aynen aşağıdaki gibi çıkıyor mailde... Benim bodyi bu htmlin içinde bir yerlere mi koymam lazım?
This text is bold
Font Color
New line with underline
Font size
Genişletmek için tıkla ...
Test edemedim, aşağıdaki şekilde deneyiniz.


Kod: 
saydir = Cells(Rows.Count, "G").End(xlUp).Row 'G sütununun son satirinı bulur
For i = 4 To saydir
If Range("P" & i) = "" And Date <= Range("M" & i) And Date >= Range("K" & i) Then

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.Display
.To = Range("S" & i)
.CC = Range("T" & i)
.BCC = ""
.Subject = "Uygunsuzluk ve Düzeltici Faaliyet Takibi"
.htmlbody = "Merhaba," & "<br/>" & "<br/>" & "<b>" & Range("G" & i) & "</b>" & "uygunsuzluğunun/iyileştirme faaliyetinin " & "<b>" & Range("M" & i) & "</b>" & " tarihinde kapatılması gererkmektedir. " & "<br/>" & "<br/>" & "Gerçekleştirilecek faaliyetin son durumu hakkında lütfen Yönetim Temsilcisine bilgi veriniz! " & "<br/>" & "<b>" & "Bu mail hatırlatma amacıyla gönderilmiştir."

'.Send 'or use
.Display
End With
On Error GoTo 0
 
M

magenta

Katılım
16 Mayıs 2017
Mesajlar
9
Excel Vers. ve Dili
2010, türkçe
Altın Üyelik Bitiş Tarihi
22.05.2022
Çok teşekkür ederim emeğinize. Faydalı oldu...
 
aliozturk55

aliozturk55

Altın Üye
Katılım
23 Temmuz 2019
Mesajlar
37
Excel Vers. ve Dili
İş Office 2010
Altın Üyelik Bitiş Tarihi
01-10-2025
Merhaba,
Seçilen bir aralığı Örn (A608:E607) aralığını seçip otomatik mail göndermek istiyorum. makro oluşturup düğmeye atayabileceğim böyle bir makro arıyorum. yardımcı olur musunuz ?
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
aliozturk55' Alıntı:
Merhaba,
Seçilen bir aralığı Örn (A608:E607) aralığını seçip otomatik mail göndermek istiyorum. makro oluşturup düğmeye atayabileceğim böyle bir makro arıyorum. yardımcı olur musunuz ?
Genişletmek için tıkla ...
Aşağıdaki şekile deneyiniz.

Kod: 
Dim mail, konu, mesaj As String

Sub menu()
    mail = [G3]
    konu = [G4]
    mesaj = [G5]
    mesaj = Replace(mesaj, ",", ", <br>")
    Call mail_gonder
End Sub


Sub mail_gonder()
      Dim wrdEdit
      Dim alana As Range

      Set alana = Range("A607:E608")
      Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)
      With OutMail
       .To = mail
       .CC = ""
       .Subject = konu
       .Display
       .HTMLBody = mesaj & "<br>" & RangetoHTML(alana) & .HTMLBody
       'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
       '.send
      End With

      Set wrdEdit = Nothing
      Set OutMail = Nothing
      Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add(SourceType:=xlSourceRange, Filename:=TempFile, Sheet:=TempWB.Sheets(1).Name, Source:=TempWB.Sheets(1).UsedRange.Address, HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst