Dosya Boyutuna Göre Otomatik Mail Gönderme

[SERHAT1634]

Merhaba arkadaşlar ,
Elimde excel dosyası mevcut ve bu dosyayı kaydettiğimde istediğim maile otomatik olarak gönderilmesini istiyorum ( Bunu excel e bir satır kaydettiğimde ve ya eklediğimde dosya boyutu degişeceği için bu ayarları baz alarak otomatik mail atmasını istiyorum )Ek olarak saatbaşıda mail göndermeyi de ekleyebilirsek çok güzel olur.
Yardımcı olursanız çok sevinirim , herkese iyi çalışmalar diliyorum..

 

[bugrakaratas]

Başka bir kaynaktan rastladığım kodu size uyarladım.
Aşağıdaki gibi kullanabilirsiniz.
Dosyayı kapattığınızda otomatik mail iletecektir.

Private Sub Workbook_BeforeClose(cancel As Boolean)
'Excel 2000-2016 da çalışır
'Üzerinde çalışılan dosyayı kapattığınızda otomatik mail atar

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 = "" 'maili göndermek istediğiniz adresi yazınız
.CC = "" 'bilgi kısmına eklemek istediğiniz mail adresini yazınız
.BCC = "" 'Gizli bilgi isterseniz eklersiniz
.Subject = "Güncel dosya" 'Konu bölümüne istediğiniz metni yazabilirsiniz
.Body = "" 'Mailin gövde kısmına istediğinizi yazabilirsiniz
.Attachments.Add ActiveWorkbook.FullName
.Display 'ben göster olarak display yazdım. Siz kodu .send olarak değiştiriniz.
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[SERHAT1634]

Çok teşekkür ederim,tam istediğim gibi oldu

 

[Asri]

Alternatif olarak, aynı kod üzerinde değişiklik ve ekleme yapıldı.

* Dosyada değişiklik yapılmış ve kaydedilmiş ise çıkışta değişiklik kontrolü yapılık değişiklik yapılmış ise mail gönderir.
* Dosyada değişiklik yapılmış ve kaydedilmemiş ise çıkışta mail gönderir.
* Dosyada değişiklik yapılmamış ve çıkış yapılıyor ise mail göndermez.

Public degisiklikvar As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Excel 2000-2016 da çalışır
'Üzerinde çalışılan dosyayı kapattığınızda otomatik mail atar
If ActiveWorkbook.Saved = True And Not degisiklikvar Then

Else

   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 = "" 'maili göndermek istediğiniz adresi yazınız
    .CC = "" 'bilgi kısmına eklemek istediğiniz mail adresini yazınız
    .BCC = "" 'Gizli bilgi isterseniz eklersiniz
    .Subject = "Güncel dosya" 'Konu bölümüne istediğiniz metni yazabilirsiniz
    .Body = "" 'Mailin gövde kısmına istediğinizi yazabilirsiniz
    .Attachments.Add ActiveWorkbook.FullName
    .Display 'ben göster olarak display yazdım. Siz kodu .send olarak değiştiriniz.
   End With
   On Error GoTo 0

   Set OutMail = Nothing
   Set OutApp = Nothing
End If

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ActiveWorkbook.Saved = True Then

    Else
      degisiklikvar = True
    End If
End Sub