Soru Cevap: Excel ile Belirli Tarihe Göre Otomatik Mail Gönderimi

Bu yazımızda Excel ile Seçili Hücreleri Mail Gönderme adlı makalemizde sorulan soruya cevap vermeye çalışacağım. Sorumuz Fatih Bey tarafından gelmiş.

Çağatay Bey Merhaba

Çalıştığım firmada kalibrasyon takibi yapıyorum ve belirlenen kalibrasyon tarihine 1 ay kaldığında excelden otomatik mail göndermek istiyorum. Bu konuda yardımcı olabilir misiniz ?

https://cagatayakinci.com/excel-ile-secili-hucreleri-mail-gonderme/

İlk olarak aşağıdaki resimde görüldüğü gibi tablo ve buton oluşturuyoruz.

C2 hücresine =GÜNSAY(B2;BUGÜN()) formülünü ekliyoruz ve kaç adet makinemiz var ise hücrenin sağ altında bulunan aşağı çekme ikonuyla çekip çoğaltıyoruz. Otomatik olarak tüm makinelerin kalibrasyon tarihine kaç gün kaldığını hücrelerde listemiş oluyoruz.

MailGonder adında makro oluşturup makronun içerisine aşağıdaki kodları kopyalıyoruz.

Sub MailGonder()
ActiveSheet.Range("$A$1:$C$5").AutoFilter Field:=3, Criteria1:="<30", _
Operator:=xlAnd
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Dim EmailApp As Outlook.Application
Dim Source As String
Dim myRange As Range
Set myRange = Selection
Set EmailApp = New Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)


EmailItem.To = "cagatay@cagatayakinci.com"
EmailItem.Subject = "Excel'den Gönderildi"
EmailItem.HTMLBody = rangetoHTML(myRange)

EmailItem.Send
ActiveSheet.Range("$A$1:$C$5").AutoFilter Field:=3
End Sub

Function rangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    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

Makroda ki Criteria1:=”<30 kısmında kalibrasyon tarihine 30 günden az kalan makinelerinin mail gönderilmesini, EmailItem.To = “cagatay@cagatayakinci.com” kısmında da mail gönderilecek olan E-Posta adresini belirtiyoruz.

Eklemiş olduğumuz Mail Gönder butonuna MailGonder makromuzu atıyoruz. Artık her butona bastığımızda kalibrasyonuna 30 günden az kalan makinelerin isimlerini, kalibrasyon tarihlerini ve kalibrasyonuna kaç gün kaldığını istenen adrese mail göndermiş oluyoruz.

Güzel soru için teşekkürler.