Soru Excel Otomatik Mail İçin Şart Ekleme

[KYenerSelvi]

Merhaba Arkadaşlar,

Aşağıdaki şekilde elimde kod mevcut. Excel'den kaydetseniz de kaydetmeseniz de çıkış yaptığınız an mail atıyor. Fakat benim istediğim kaydetmeden çıkış yaparsa mail atmasın. Eğer hem kaydeder hemde çıkış yaparsa mail atsın.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .to = "xxx@tgs.aero"
        .CC = "xxxx@tgs.aero"
        .BCC = ""
        .Subject = "mmm - " & Date
        .Body = "Merhaba," & Chr(10) & Chr(10) & "Bu bir otomatik gönderilen E-Posta 'dır." & Chr(10) & Chr(10) & "Saygılarımla,"
        .Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[KYenerSelvi]

Arkadaşlar konu hakkında yardımcı olabilir misiniz bana

 

[Emir Hüseyin Çoban]

.

Kaydetti / kaydetmedi ayrımı biraz zor olabilir.
Onun yerine kapatırken sorsa mail atmak istiyor musunuz Evet / Hayır diye.

.

 

[AdemCan]

Dosyanın kayıt edilip edilmediği Public olarak belirlenen bir değişken ile kontrol edebilirsiniz.

Bunun için herhangi bir modül içerisinde ilk satıra Public deger As Byte satırını ekleyiniz.

Örnek olarak dosya ilk açıldığında deger isimli değişkeni sıfıra ( 0 ) eşitledim.

Private Sub Workbook_Open()
    deger = 0
End Sub

Dosya kayıt edildiğinde ise bire ( 1 ) eşitledim.

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    deger = 1
End Sub

Burada şöyle bir durum söz konusu, dosyayı açtınız ve arkasından hemen kaydet tuşuna bastınız, artık deger her zaman 1 olacak.
Dosya üzerinde değişiklik yapıldığında degerin tekrar 0 olması için

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    deger = 0
End Sub

kodunu kullanmalısınız. Diğer işlemlerinizde de deger = 0 satırını kullanabilirsiniz.

En son dosyayı kapatan kodların içiresinde deger değişkenini kontrol etmek için

If deger = 0 Then
    MsgBox "Dosyayı kayıt etmelisiniz."
    Cancel = True
    Exit Sub
End If

kodlarını kullanabilirsiniz.

 

[Haluk]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object
    
    If ThisWorkbook.Saved Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next
        With OutMail
'       ............
'       .........
'       .....
'       ....
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
End Sub

.

 

[KYenerSelvi]

Verdiğiniz kodlar ile sorun çözüldü.

Hepinize teşekkür ederim arkadaşlar