Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > Diğer Yazılımlar > Yazılım ve Donanım
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Yazılım ve Donanım Yazılım ve Donanım konuları ve diğer kullanıcılara tavsiye etmek istediğiniz programların açıklamaları.

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 23-05-2017, 00:03   #1
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 2,553
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Varsayılan Outlook Gelen Mail İçerik Filtreleme VBA

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.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 07:15


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Perde- Çorlu Havuz- Çorlu Havuz- Makina- Danışmazlar- Çorlu Perde Yıkama- Çorlu Perde Yıkama- Okul Danışmanlık- Çorlu Ayakkabı- İzmit Sigorta-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden