Uyarı maili alma

[cavanoos]

Merhaba arkadaşlar;

Bir hayalim var ama excel ile yapılabilir mi bilmiyorum.
Sizinle paylaşmak istedim, fikir almak istedim.

İhracat listesi dosyamız var. İhracatın yapıldığı tarihten 160 gün sonra bankalarda işlem yapmamız gerekiyor.
Biz bu işlemi manuel olarak takip ediyoruz. Peki şöyle yapılabilir mi ?

160 gün sonra mail adresime uyarı gelebilir mi ?

 

[cems]

Hayaliniz vba ile gerçeğe donusebilir ...


Gerekli programı oluşturma için ön bilgiler

1. İhracat Tarihleri:
   • İhracat tarihlerinin hangi sütunda bulunduğu (örneğin, A sütunu).
   • Tarihlerin başlangıç hücresi (örneğin, A2).
2. E-posta Adresi:
   • Uyarı e-postalarının gönderileceği e-posta adresi. Kullanıcının kendi e-posta adresini vermesi gerekir.
3. Excel Sayfa Adı:
   • İlgili ihracat tarihlerini içeren sayfanın adı (örneğin, "Sheet1"). Kullanıcı bunu değiştirmek isteyebilir.
4. Hedef E-posta İçeriği:
   • E-postanın konusu ve içeriği hakkında tercihleri. Örneğin, e-postada hangi bilgilerin yer almasını istiyorlar (sadece tarih mi, yoksa başka bilgiler de mi).
5. Sıklık Ayarları:
   • E-posta uyarılarının ne zaman gönderilmesini istediklerini belirtmeleri (her açılışta mı, yoksa belirli bir zaman diliminde mi).
6. Makro Çalıştırma İzinleri:
   • Kullanıcının Excel'de makrolara izin verip vermediği. Bu, makronun çalışabilmesi için gereklidir.
7. Outlook Yapılandırması:
   • Kullanıcının bilgisayarında Outlook'un kurulu ve yapılandırılmış olduğundan emin olunması.

Ekstra Bilgiler (Opsiyonel)

• Veri Güncelleme: Kullanıcıdan, ihracat tarihlerinin düzenli olarak güncellenip güncellenmeyeceği hakkında bilgi almak.
• Hata Yönetimi: E-posta gönderiminde sorun olması durumunda kullanıcıya nasıl bir uyarı yapılması gerektiği.
• İhtiyaç Duyulan Ek Özellikler: Kullanıcının başka herhangi bir özel talebi veya ek özellik isteyip istemediği.

 

[cems]

Ya da mail atmak degil de dosyayı her iş günü açıyorsanız 160 gun sonra msgbox ile de uyarı almanız mumkun olabilir ...

Sub CheckExportDates()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim exportDate As Date
    Dim i As Long
    Dim alertDate As Date
    Dim currentDate As Date
    Dim message As String

    ' Aktif sayfayı ayarla
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Sayfa adını değiştirin
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    currentDate = Date
    message = ""

    ' Tarihleri kontrol et
    For i = 2 To lastRow ' 1. satır başlık
        exportDate = ws.Cells(i, 1).Value ' A sütunu
        alertDate = exportDate + 160
        
        ' AlertDate'in hafta sonuna denk gelip gelmediğini kontrol et
        If Weekday(alertDate, vbMonday) > 5 Then
            alertDate = alertDate + (8 - Weekday(alertDate, vbMonday))
        End If
        
        ' Eğer uyarı tarihi geldi ise
        If currentDate >= alertDate Then
            message = message & "İhracat tarihi: " & exportDate & " için 160 gün geçti." & vbCrLf
        End If
    Next i

    ' Eğer mesaj varsa, göster
    If message <> "" Then
        MsgBox message, vbExclamation, "İhracat Uyarısı"
    End If
End Sub

 

[cavanoos]

Cems Bey;

İlginiz için teşekkür ederim, inceleyip döneceğim.

 

[Biolightant]

Merhaba,

160 gün sonra mail

varmış öyle bir şey ( DeferredDeliveryTime )
Tabi o saatte Outlook Açık ve internet bağlantısı olmalı.

Sub PostdatedEmail()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim strTo As String
    Dim strSubject As String
    Dim strBody As String
    Dim teslimZamani As Date
   
    teslimZamani = DateAdd("n", 3, Now) ' 3 dk sonra [ DateAdd("d", 160, Now) ] -> 160 gün sonra
   
    strTo = "info@mailadresiniziyazin.com" ' mail adresiniz
   
    strSubject = "mail zaman kontrol test"
    strBody = "bu mail oluşturulduğu zaman       : " & Now & vbCrLf _
    & "(+3Dk) Size gönderileceği zaman : " & teslimZamani
   
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
   
    With objMail
        .To = strTo
        .Subject = strSubject
        .Body = strBody
        .DeferredDeliveryTime = teslimZamani
        .Send
    End With

    Set objMail = Nothing
    Set objOutlook = Nothing

End Sub

 

[Biolightant]

Tatil günleri aklıma geldi en azından
Cumartesi Pazar günlerini göz önüne alarak
160 gün sonra hangi gün olduğuna bakarak
Format(DateAdd("d", 160, Now), "dddd")
VBA kodları ayarlamalısınız

 

[cavanoos]

Ya da mail atmak degil de dosyayı her iş günü açıyorsanız 160 gun sonra msgbox ile de uyarı almanız mumkun olabilir ...

Sub CheckExportDates()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim exportDate As Date
    Dim i As Long
    Dim alertDate As Date
    Dim currentDate As Date
    Dim message As String

    ' Aktif sayfayı ayarla
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Sayfa adını değiştirin
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    currentDate = Date
    message = ""

    ' Tarihleri kontrol et
    For i = 2 To lastRow ' 1. satır başlık
        exportDate = ws.Cells(i, 1).Value ' A sütunu
        alertDate = exportDate + 160
       
        ' AlertDate'in hafta sonuna denk gelip gelmediğini kontrol et
        If Weekday(alertDate, vbMonday) > 5 Then
            alertDate = alertDate + (8 - Weekday(alertDate, vbMonday))
        End If
       
        ' Eğer uyarı tarihi geldi ise
        If currentDate >= alertDate Then
            message = message & "İhracat tarihi: " & exportDate & " için 160 gün geçti." & vbCrLf
        End If
    Next i

    ' Eğer mesaj varsa, göster
    If message <> "" Then
        MsgBox message, vbExclamation, "İhracat Uyarısı"
    End If
End Sub

Cems;

Kodu denedim, gayet güzel çalışıyor.
Dosyayı her açtığımda aynı faturalar için uyarı veriyor.
Halbuki olması gereken daha önce uyarı verilenleri devre dışı bırakarak 160 gün şartına uyanlar için uyarı almak olmalı.
Bunu nasıl yapabiliriz diye düşündüm. Uyarı verenler için mesela D sütununa "uyarıldı" değeri girilmiş olsa, sonrasında kod çalıştırılırken D sütunu boş olanlar ve tarih koşuluna uyanlar için, uyarı mesajı atabilir miyiz.

 

[cavanoos]

Merhaba,

varmış öyle bir şey ( DeferredDeliveryTime )
Tabi o saatte Outlook Açık ve internet bağlantısı olmalı.

Sub PostdatedEmail()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim strTo As String
    Dim strSubject As String
    Dim strBody As String
    Dim teslimZamani As Date
  
    teslimZamani = DateAdd("n", 3, Now) ' 3 dk sonra [ DateAdd("d", 160, Now) ] -> 160 gün sonra
  
    strTo = "info@mailadresiniziyazin.com" ' mail adresiniz
  
    strSubject = "mail zaman kontrol test"
    strBody = "bu mail oluşturulduğu zaman       : " & Now & vbCrLf _
    & "(+3Dk) Size gönderileceği zaman : " & teslimZamani
  
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
  
    With objMail
        .To = strTo
        .Subject = strSubject
        .Body = strBody
        .DeferredDeliveryTime = teslimZamani
        .Send
    End With

    Set objMail = Nothing
    Set objOutlook = Nothing

End Sub

Biolightant;

Tarih sütunu kodun içinde nerede, hangi alanı değiştireceğim.
Cems'e yanıt verirken dosya eklemiştim.
Onun üstünde örnek uygulama yapabilir misin ?

 

[denizfatihi]

Merhaba,

Konunun devamı gibi olduğu için ayrı bir başlık açmak istemedim, kod normalde süzme işlemini ilgili alanları seçiyor yalnız yapıştır kısmına gelince boş alan yapıştırdığı için mail de boş geliyor.
Hangi kısmında hata yapıyorum ? Teşekkür ederim.

Sub MailKredi()

Zaman = Time
Tarih = Date + 21

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
Dim sh As Worksheet
Set EmailItem = EmailApp.CreateItem(olMailItem)

 On Error Resume Next
 Sayfa1.Select
  'Kredi.Select
    
Set sh = Sheets("Kredi")
        
   ActiveSheet.Range("$A$2:$D$5000").AutoFilter Field:=2, Criteria1:="<=" & CLng(CDate(Tarih)), Operator:=xlAnd
        
 
Sayfa1.Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

EmailItem.To = "test@test.com.tr"
EmailItem.Subject = "Vadesi gelen/yaklaşan kredi/krediler"
EmailItem.HTMLBody = rangetoHTML(myRange)
'EmailItem.Send
EmailItem.Send
On Error GoTo 0
ActiveSheet.Range("$A$2:$D$5000").AutoFilter 'Field:=2
'ActiveSheet.ListObjects("Sorgu1").Range.AutoFilter Field:=20
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

 

[hasankardas]

Sub UyarilariKontrolEtVeGuncelle()
    Dim ws As Worksheet
    Dim i As Long
    Dim Bugun As Date
    Dim TarihFarki As Long
        Set ws = ThisWorkbook.Sheets("İhracat Listesi")
    Bugun = Date      
    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        If ws.Cells(i, 4).Value = "Uyarıldı" Then
            ws.Cells(i, 4).Interior.ColorIndex = xlNone
        End If
    Next i  
    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row      
        If ws.Cells(i, 4).Value <> "Uyarıldı" Then          
            TarihFarki = Bugun - ws.Cells(i, 1).Value
            If TarihFarki >= 160 Then              
                ws.Cells(i, 4).Value = "Uyarıldı"
                ws.Cells(i, 4).Interior.Color = RGB(255, 165, 0)
            End If
        End If
    Next i
End Sub

A sütununda 160 ve üzerinde olanları uyarıldı olarak d sütununa yazıyor. Yeni bir şart sağlandığında onu turuncu rengi ile yapıyor.. Butona tekrar basıldığında turuncu rengi kaldırıyor. kıstası bugüne göre alıyor
dener misiniz

 

[cavanoos]

Sub UyarilariKontrolEtVeGuncelle()
    Dim ws As Worksheet
    Dim i As Long
    Dim Bugun As Date
    Dim TarihFarki As Long
        Set ws = ThisWorkbook.Sheets("İhracat Listesi")
    Bugun = Date     
    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        If ws.Cells(i, 4).Value = "Uyarıldı" Then
            ws.Cells(i, 4).Interior.ColorIndex = xlNone
        End If
    Next i 
    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row     
        If ws.Cells(i, 4).Value <> "Uyarıldı" Then         
            TarihFarki = Bugun - ws.Cells(i, 1).Value
            If TarihFarki >= 160 Then             
                ws.Cells(i, 4).Value = "Uyarıldı"
                ws.Cells(i, 4).Interior.Color = RGB(255, 165, 0)
            End If
        End If
    Next i
End Sub

A sütununda 160 ve üzerinde olanları uyarıldı olarak d sütununa yazıyor. Yeni bir şart sağlandığında onu turuncu rengi ile yapıyor.. Butona tekrar basıldığında turuncu rengi kaldırıyor. kıstası bugüne göre alıyor
dener misiniz

Hasankardas;

İstediğimiz tam olarak bu değil.

Aşama aşama gidersem, kodu ilk defa çalıştırdığımı varsayın.
İkinci satırdaki veri için uyarı gelecek. Çünkü 160 gün geçti.
İkinci satırdaki D sütununa Uyarıldı yazacak.

Aradan bir hafta geçti ve tekrar çalıştırdım.
D sütununda Uyarıldı yazan gelmeyecek.
160 günü geçen veriler için uyarı gelecek.

 

[hasankardas]

Hasankardas;

İstediğimiz tam olarak bu değil.

Aşama aşama gidersem, kodu ilk defa çalıştırdığımı varsayın.
İkinci satırdaki veri için uyarı gelecek. Çünkü 160 gün geçti.
İkinci satırdaki D sütununa Uyarıldı yazacak.

Aradan bir hafta geçti ve tekrar çalıştırdım.
D sütununda Uyarıldı yazan gelmeyecek.
160 günü geçen veriler için uyarı gelecek.

Siz 7 ci mesaj da istediğiniz nedir? d sütununa uyarı mesajı yazsın demişsiniz. üzerine bir eklem daha yapıp karışıklık olmasın diye yeni uyarı olanları renklendirme yapmışız. Şimdi de ne diyorsunuz önce uyarı verdikleri kalksın yeni uyarı versin. zaten onu yapıyor turuncuya boyayarak. Ha illa uyarı yazısı gözükmesin istiyorsanız yazı rengini beyaz yaparsanız sadece renk görünür. istediğiniz olmuş olur..

 

[Biolightant]

Yeniden Merhaba,

@cavanoos Manuel olarak,

Outlook çalıştırınız,
Yukarıda ki menüden Giriş - Yeni E-Posta Tıklayınız.
Yeni Oluşturulacak olan yeni epostanın Yukarıda ki Menüsünden
Seçenekler - Teslimi Geciktir Tıklayınız
Açılan pencere de Bu Tarihten önce teslim etme seçeneği (mailin ileri teslim tarihini istediğiniz zaman belirleyebilirsiniz.)
Konuyu açtığınız da ilk istediğiniz buydu sanırım ileri tarihli mail oluşturmak (160 gün sonra mail adresime uyarı gelebilir mi ? )

Manuel olarak yukarıda yaptığınız bu işi VBA kodları ile yapabilirsiniz
Bakınız yukarıda benim yazdığım VBA kodlar

veya bu yeni kodları inceleyiniz
info@mailadresiniziyazin.com yerine
kendi kendinize 160 gün sonra mesaj atabilmek için kendi mail adresinizi yazınız.

Not: kodları çalıştırdığınızda mail gitmeyecek izlemenize olanak sağlayacak
VBA ile oluşturulan mail in Üst menüsünden Seçenekler - Teslimi geciktir i inceleyiniz.

Sub PostdatedEmail()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim strTo As String
    Dim strSubject As String
    Dim strBody As String
    Dim teslimZamani As Date

    teslimZamani = DateAdd("d", 160, Now) ' 160 gün sonra mail teslim edilecek (Seçenekler - Teslimi geçiktir bakınız )

    strTo = "info@mailadresiniziyazin.com" ' kendi mail adresinizi yazınız

    strSubject = "mail zaman kontrol test"
    strBody = "bu mail oluşturulduğu zaman       : " & Now & vbCrLf _
    & "(+160Gün) Size gönderileceği zaman : " & teslimZamani

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With objMail
        .To = strTo
        .Subject = strSubject
        .Body = strBody
        .DeferredDeliveryTime = teslimZamani
        .Display
        ' .Send
    End With

    Set objMail = Nothing
    Set objOutlook = Nothing

End Sub

Onun üstünde örnek uygulama yapabilir misin

Malesef sizin kodları göremediğim için yapamam
hem ilk iş olarak programın ana amacı olan ileri tarihli mail oluşturabilmek
mail in içeriği oluşturmak ise sonradan yapılacak iş.

 

[cems]

Cems;

Kodu denedim, gayet güzel çalışıyor.
Dosyayı her açtığımda aynı faturalar için uyarı veriyor.
Halbuki olması gereken daha önce uyarı verilenleri devre dışı bırakarak 160 gün şartına uyanlar için uyarı almak olmalı.
Bunu nasıl yapabiliriz diye düşündüm. Uyarı verenler için mesela D sütununa "uyarıldı" değeri girilmiş olsa, sonrasında kod çalıştırılırken D sütunu boş olanlar ve tarih koşuluna uyanlar için, uyarı mesajı atabilir miyiz.

sadece daha önce uyarı verilmeyen (D sütununda boş olan) tarihler için uyarı almak mümkün. Aşağıda, mevcut kodunu güncelleyerek D sütununa "uyarıldı" değerini kontrol eden ve sadece boş olan hücreler için uyarı veren bir versiyonunu deneyin


Sub CheckExportDates()
Dim ws As Worksheet
Dim lastRow As Long
Dim exportDate As Date
Dim i As Long
Dim alertDate As Date
Dim currentDate As Date
Dim message As String

' Aktif sayfayı ayarla
Set ws = ThisWorkbook.Sheets("Sheet1") ' Sayfa adını değiştirin
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
currentDate = Date
message = ""

' Tarihleri kontrol et
For i = 2 To lastRow ' 1. satır başlık
exportDate = ws.Cells(i, 1).Value ' A sütunu
alertDate = exportDate + 160

' AlertDate'in hafta sonuna denk gelip gelmediğini kontrol et
If Weekday(alertDate, vbMonday) > 5 Then
alertDate = alertDate + (8 - Weekday(alertDate, vbMonday))
End If

' Eğer uyarı tarihi geldi ise ve D sütunu boşsa
If currentDate >= alertDate And ws.Cells(i, 4).Value = "" Then ' D sütunu
message = message & "İhracat tarihi: " & exportDate & " için 160 gün geçti." & vbCrLf

' Uyarı verildiğini belirtmek için D sütununa "uyarıldı" yaz
ws.Cells(i, 4).Value = "uyarıldı"
End If
Next i

' Eğer mesaj varsa, göster
If message <> "" Then
MsgBox message, vbExclamation, "İhracat Uyarısı"
End If
End Sub

 

[cavanoos]

Yeniden Merhaba,

@cavanoos Manuel olarak,

Outlook çalıştırınız,
Yukarıda ki menüden Giriş - Yeni E-Posta Tıklayınız.
Yeni Oluşturulacak olan yeni epostanın Yukarıda ki Menüsünden
Seçenekler - Teslimi Geciktir Tıklayınız
Açılan pencere de Bu Tarihten önce teslim etme seçeneği (mailin ileri teslim tarihini istediğiniz zaman belirleyebilirsiniz.)
Konuyu açtığınız da ilk istediğiniz buydu sanırım ileri tarihli mail oluşturmak (160 gün sonra mail adresime uyarı gelebilir mi ? )

Manuel olarak yukarıda yaptığınız bu işi VBA kodları ile yapabilirsiniz
Bakınız yukarıda benim yazdığım VBA kodlar

veya bu yeni kodları inceleyiniz
info@mailadresiniziyazin.com yerine
kendi kendinize 160 gün sonra mesaj atabilmek için kendi mail adresinizi yazınız.

Not: kodları çalıştırdığınızda mail gitmeyecek izlemenize olanak sağlayacak
VBA ile oluşturulan mail in Üst menüsünden Seçenekler - Teslimi geciktir i inceleyiniz.

Sub PostdatedEmail()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim strTo As String
    Dim strSubject As String
    Dim strBody As String
    Dim teslimZamani As Date

    teslimZamani = DateAdd("d", 160, Now) ' 160 gün sonra mail teslim edilecek (Seçenekler - Teslimi geçiktir bakınız )

    strTo = "info@mailadresiniziyazin.com" ' kendi mail adresinizi yazınız

    strSubject = "mail zaman kontrol test"
    strBody = "bu mail oluşturulduğu zaman       : " & Now & vbCrLf _
    & "(+160Gün) Size gönderileceği zaman : " & teslimZamani

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With objMail
        .To = strTo
        .Subject = strSubject
        .Body = strBody
        .DeferredDeliveryTime = teslimZamani
        .Display
        ' .Send
    End With

    Set objMail = Nothing
    Set objOutlook = Nothing

End Sub

Malesef sizin kodları göremediğim için yapamam
hem ilk iş olarak programın ana amacı olan ileri tarihli mail oluşturabilmek
mail in içeriği oluşturmak ise sonradan yapılacak iş.

Biolightant;

Bende kod yok zaten, kod arıyoruz
Mail üzerinde de herhangi bir ayar yapılmayacak.
Direkt excelden, koşula uyanlar, mail atılacak.

 

[cavanoos]

sadece daha önce uyarı verilmeyen (D sütununda boş olan) tarihler için uyarı almak mümkün. Aşağıda, mevcut kodunu güncelleyerek D sütununa "uyarıldı" değerini kontrol eden ve sadece boş olan hücreler için uyarı veren bir versiyonunu deneyin


Sub CheckExportDates()
Dim ws As Worksheet
Dim lastRow As Long
Dim exportDate As Date
Dim i As Long
Dim alertDate As Date
Dim currentDate As Date
Dim message As String

' Aktif sayfayı ayarla
Set ws = ThisWorkbook.Sheets("Sheet1") ' Sayfa adını değiştirin
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
currentDate = Date
message = ""

' Tarihleri kontrol et
For i = 2 To lastRow ' 1. satır başlık
exportDate = ws.Cells(i, 1).Value ' A sütunu
alertDate = exportDate + 160

' AlertDate'in hafta sonuna denk gelip gelmediğini kontrol et
If Weekday(alertDate, vbMonday) > 5 Then
alertDate = alertDate + (8 - Weekday(alertDate, vbMonday))
End If

' Eğer uyarı tarihi geldi ise ve D sütunu boşsa
If currentDate >= alertDate And ws.Cells(i, 4).Value = "" Then ' D sütunu
message = message & "İhracat tarihi: " & exportDate & " için 160 gün geçti." & vbCrLf

' Uyarı verildiğini belirtmek için D sütununa "uyarıldı" yaz
ws.Cells(i, 4).Value = "uyarıldı"
End If
Next i

' Eğer mesaj varsa, göster
If message <> "" Then
MsgBox message, vbExclamation, "İhracat Uyarısı"
End If
End Sub

Cems;

Eline sağlık.
Kodunuzu dosya açarken çalışması üzerine kodladım, daha güzel oldu.
Gelen uyarı mesajının içeriğini değiştirebilir miyiz ?
& exportDate & kısmı yerine B sütunundaki ilgili satırdaki ihracat numarası olabilir mi ?

 

[cems]

message = message & "İhracat numarası: " & exportNumber & " için 160 gün geçti." & vbCrLf

Kısmında " " arasını degiştirebilirsiniz.

Deneyin ben denemeden gonderiyorum

Sub CheckExportDates()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim exportDate As Date
    Dim exportNumber As String
    Dim i As Long
    Dim alertDate As Date
    Dim currentDate As Date
    Dim message As String

    ' Aktif sayfayı ayarla
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Sayfa adını değiştirin
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    currentDate = Date
    message = ""

    ' Tarihleri kontrol et
    For i = 2 To lastRow ' 1. satır başlık
        exportDate = ws.Cells(i, 1).Value ' A sütunu
        exportNumber = ws.Cells(i, 2).Value ' B sütunu
        alertDate = exportDate + 160
      
        ' AlertDate'in hafta sonuna denk gelip gelmediğini kontrol et
        If Weekday(alertDate, vbMonday) > 5 Then
            alertDate = alertDate + (8 - Weekday(alertDate, vbMonday))
        End If

        ' Eğer uyarı tarihi geldi ise ve D sütunu boşsa
        If currentDate >= alertDate And ws.Cells(i, 4).Value = "" Then ' D sütunu
            message = message & "İhracat numarası: " & exportNumber & " için 160 gün geçti." & vbCrLf
          
            ' Uyarı verildiğini belirtmek için D sütununa "uyarıldı" yaz
            ws.Cells(i, 4).Value = "uyarıldı"
        End If
    Next i

    ' Eğer mesaj varsa, göster
    If message <> "" Then
        MsgBox message, vbExclamation, "İhracat Uyarısı"
    End If
End Sub

 

[cavanoos]

message = message & "İhracat numarası: " & exportNumber & " için 160 gün geçti." & vbCrLf

Kısmında " " arasını degiştirebilirsiniz.

Deneyin ben denemeden gonderiyorum

Sub CheckExportDates()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim exportDate As Date
    Dim exportNumber As String
    Dim i As Long
    Dim alertDate As Date
    Dim currentDate As Date
    Dim message As String

    ' Aktif sayfayı ayarla
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Sayfa adını değiştirin
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    currentDate = Date
    message = ""

    ' Tarihleri kontrol et
    For i = 2 To lastRow ' 1. satır başlık
        exportDate = ws.Cells(i, 1).Value ' A sütunu
        exportNumber = ws.Cells(i, 2).Value ' B sütunu
        alertDate = exportDate + 160
     
        ' AlertDate'in hafta sonuna denk gelip gelmediğini kontrol et
        If Weekday(alertDate, vbMonday) > 5 Then
            alertDate = alertDate + (8 - Weekday(alertDate, vbMonday))
        End If

        ' Eğer uyarı tarihi geldi ise ve D sütunu boşsa
        If currentDate >= alertDate And ws.Cells(i, 4).Value = "" Then ' D sütunu
            message = message & "İhracat numarası: " & exportNumber & " için 160 gün geçti." & vbCrLf
         
            ' Uyarı verildiğini belirtmek için D sütununa "uyarıldı" yaz
            ws.Cells(i, 4).Value = "uyarıldı"
        End If
    Next i

    ' Eğer mesaj varsa, göster
    If message <> "" Then
        MsgBox message, vbExclamation, "İhracat Uyarısı"
    End If
End Sub

Teşekkür ederim, elinize sağlık

 

[cems]

Kolaylıklar ve verimli ihracatlar dilerim