uyarı maili

[spacebar]

arkadaşlar merhaba. ik için yapılmış bir çalışma var elimde. personelin işe giriş tarihinden 55 gün ve 175 gün sonra uyarı olarak mail gönderiyor. yalnız bir revize yapılması gerekiyor. yapılması istenen cumartesi pazar gününe gelen uyarı maillerini daha önce göndermesi. yani uyarı tarihi 24.09.2017 ise bunu 22.09.2017 de göndermesi. yardımlarınız için şimdiden teşekkürler.

dosya : http://dosya.co/z55yceiqmfw2/uyarı_maili_SON_orjinal1.xlsm.html

 

[askm]

Aşağıdaki kodları deneyin.

   Private Sub Workbook_Open()
   
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Dim xlOutlook   As Object
    Dim xlMail      As Object
    
    For i = 3 To [C65536].End(3).Row
        Tarih1 = Cells(i, "C") + 55
        If Application.Weekday(Tarih1, 2) = 7 Then Tarih1 = Tarih1 - 2
        If Application.Weekday(Tarih1, 2) = 6 Then Tarih1 = Tarih1 - 1
        If Tarih1 = Date Then
            mesaj = Cells(i, "B") & " adlı personelin deneme süresinin dolmasına birkaç gün kalmıştır. Devam onayının İnsan Kaynakları müdürlüğüne bildirilmesini rica ederim."
            Set xlOutlook = CreateObject("Outlook.Application")
            Set xlMail = xlOutlook.CreateItem(0)
            With xlMail
                .To = Cells(i, "D")
                
                .Subject = "Personel durum bilgisi"
                .Body = mesaj
                .Save
                '.Display
                .Send
            End With
        Else
        End If
        
        Tarih2 = Cells(i, "C") + 175
        If Application.Weekday(Tarih2, 2) = 7 Then Tarih2 = Tarih2 - 2
        If Application.Weekday(Tarih2, 2) = 6 Then Tarih2 = Tarih2 - 1
        If Tarih2 = Date Then
            mesaj = Cells(i, "B") & " adlı personelin 6 aylık iş güvenliği süresine birkaç gün kalmıştır. Devam onayının Müdürlüğümüze bildirilmesini rica ederim."
            Set xlOutlook = CreateObject("Outlook.Application")
            Set xlMail = xlOutlook.CreateItem(0)
            With xlMail
                .To = Cells(i, "D")
                
                .Subject = "Personel Durum Bilgisi"
                .Body = mesaj
                .Save
                '.Display
                .Send
            End With
        Else
        End If
        
        Set xlMail = Nothing
        Set xlOutlook = Nothing
    Next i
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[spacebar]

üstad yardımlarınız için çok teşekkür ederim. iyi çalışmalar dilerim...

 

[askm]

Rica ederim. Kolay gelsin.