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,372
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 01:10


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden