- Katılım
- 24 Nisan 2005
- Mesajlar
- 3,652
- Excel Vers. ve Dili
- Office 2016 EN 64 Bit
- Altın Üyelik Bitiş Tarihi
- 25/05/2022
Bugün virüslü mailler için birşey yapabilir miyim diye düşününce, local bir çözüm olarak her gelen maili geldiği anda hem konu hemde içerik olarak inceleyen bir VBA kodu kısmen de olsa çözüm olur diye düşündüm.
Kodlar henüz test aşamasında. Mail geldiği anda hemen konu ve içerik olarak yasakkelimeler i arıyor ve bulduğunda gelen kutusu altındaki Deneme klasörüne taşıyor.
yasakkelimeler = "DROPBOX,DROPBOXCONTENT"
Bu kelimeler virgül ile çoğaltılabilir.
Bu kodlare eklemeler yapılarak yapılabilecekler
* Eklenti türüne göre kontroller yapılabilir.
* Virüs olabilecek mailler geldiği anda silinebilir.
* Outlook kuralları kullanmadan bu kodlar ile gelen mailler üzerinde işlemler yapılabilir. (Başka birine yönlendirme, farklı klasörlere kopyala, taşıma gibi)
Kodların çalışması için Outlook da makrolar etkinleştirilmelidir. Bu ne kadar güvenli bir durum olur tartışılır
Kodlar outlook da ThisOutlookSession bölümüne kopyalanmalı ve outlook yeniden başlatılmalıdır.
Kodlar henüz test aşamasında. Mail geldiği anda hemen konu ve içerik olarak yasakkelimeler i arıyor ve bulduğunda gelen kutusu altındaki Deneme klasörüne taşıyor.
yasakkelimeler = "DROPBOX,DROPBOXCONTENT"
Bu kelimeler virgül ile çoğaltılabilir.
Bu kodlare eklemeler yapılarak yapılabilecekler
* Eklenti türüne göre kontroller yapılabilir.
* Virüs olabilecek mailler geldiği anda silinebilir.
* Outlook kuralları kullanmadan bu kodlar ile gelen mailler üzerinde işlemler yapılabilir. (Başka birine yönlendirme, farklı klasörlere kopyala, taşıma gibi)
Kodların çalışması için Outlook da makrolar etkinleştirilmelidir. Bu ne kadar güvenli bir durum olur tartışılır
Kodlar outlook da ThisOutlookSession bölümüne kopyalanmalı ve outlook yeniden başlatılmalıdır.
Kod:
Public olApp As Outlook.Application
Public objNS As Outlook.NameSpace
Public tasinacak As Boolean
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim Subject As String
yasakkelimeler = "DROPBOX,DROPBOXCONTENT"
If TypeName(Item) = "MailItem" Then
Subject = Item.Subject
veri = UCase(Item.Body)
kelimeler = Split(yasakkelimeler, ",")
For i = LBound(kelimeler) To UBound(kelimeler)
kelime = kelimeler(i)
If InStr(Subject, kelime) > 0 Or InStr(veri, kelime) > 0 Then
Item.Move objNS.GetDefaultFolder(olFolderInbox).Folders("Deneme")
Exit For
End If
Next i
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub