Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Yazılım ve Donanım (http://www.excel.web.tr/forumdisplay.php?f=52)
-   -   Outlook Özel Kurallar, İşlemler Menüsü - Test Sürümü (http://www.excel.web.tr/showthread.php?t=164412)

asri 31-05-2017 22:57

Outlook Özel Kurallar, İşlemler Menüsü
 
Outlook Özel Kurallar İşlemler Menüsü
Program iki bölümden oluşmaktadır.

1 . Bölümde,
Ekrana gelecek bir menü ile farklı işlemler yapılabilecek.
ozel_islemler makrosu aktif edilerek, çıkacak ekranda farklı işlemler yapabilir siniz.
Şu an için belirtilen mail adresine ait mailleri seçilen klasöre taşımaktadır. Bu bölüm sürekli geliştirilecektir.

Program yapabildikleri,

*Seçilen epostalardaki, belirlenen eposta ya ait tüm epostaları taşı
*Seçilen epostalardaki, belirlenen alan adına ait tüm epostaları taşı
*Seçilen epostalardaki gönderenleri dosyaya kaydet.
*Seçilen epostalardaki alıcıları dosyaya kaydet.
*Seçilen epostalardaki tüm ekleri sormadan siler. Uzantı belirtilmez ise tüm eklere uygulanır.
*Seçilen epostalardaki tüm ekleri sorarak siler. Uzantı belirtilmez ise tüm eklere uygulanır.
*Seçilen epostalardaki tüm ekleri kaydet. Uzantı belirtilmez ise tüm eklere uygulanır. Hepsini tek klasöre mi, Aynı isimli dosyaların ismini değiştir
* Seçilen epostalarda, BİLGİ de olan eposta ya ait tüm epostaları taşı
* Seçilen epostalarda, KİME de olan eposta ya ait tüm epostaları taşı
* Seçilen epostalardaki, eposta boyutu bundan büyük olanları taşı. Kaç KB , Nereye
* Seçilen epostalardaki, eposta boyutu bundan küçük olanları taşı. Kaç KB , Nereye
* Seçilen epostadaki konuya göre filtre uygula
* Tüm filtreleri temizle
* Seçilen epostaları msg olarak kaydet
* Seçilen epostaları txt olarak kaydet, ayrı dosyalarda
* Seçilen epostaları txt olarak kaydet, tek dosyada
* Tüm klasörleri genişlet
* Outlook versiyonu


2 . Bölümden
Outlook da gelen mailleri takip eden bu kodlar ile farklı kurallar oluşturabilirsiniz. Mail alındığı anda otomatik olarak devreye girer.

Outlook da gelen mailleri takip eden bu kodlar ile farklı kurallar oluşturabilirsiniz. Mail alındığı anda otomatik olarak devreye girer.

Yapılabilecek işlemler aşağıdaki şekildedir. Örnek kodlar yazılmış durumda. Bu kod yapısı ile farklı seçenekler üretilebilir.

Outlook ile bilgisayara komutlar gönderebilirsiniz.
Mail de konu ya aşağıdaki bilgileri yazdığınızda outlook maili aldığında aşağıdak işlemleri gerçekleştirecektir.

Komut:Kilitle
Komut:Oturumu Kapat
Komut:Bilgisayarı Kapat
Komut:Yeniden Başlat
Komut:Çalıştır Notepad

Yönlendirme Kuralları
Kod içinde gönderen mail adresi ve konuda eşit ise belirlenen mail adresine gelen maili gönderme
Kod içinde gönderen mail adresi eşit ise belirlenen mail adresine gelen maili gönderme
Kod içinde gönderen alanadı eşit ise belirlenen mail adresine gelen maili gönderme

Spam mail kontrolü, Konu ve içeriğe göre mailleri taşı

Spam olabilecek kelimeleri virgül , kullanarak ekleyiniz.
yasakkelimeler = "DROPBOX,DROPBOXCONTENT,FATTURA"

Yasak alan adına göre maili taşı
Yasaklı alan adlarını virgül , kullanarak ekleyiniz.
yasakalanadlari = "spamdomain.ru,spamdomain.com"

Web sitesinde özel kuralların kaynak kodu da bulunmaktadır.
Outlook VBA da tüm kodlar erişilebilir durumdadır.

http://asriakdeniz.com/outlook-ozel-...slemler-menusu

http://asriakdeniz.com/wp-content/up...elislemler.jpg

ridvanucok 01-06-2017 18:02

Üstadım merhaba,

Öncelikle eline sağlık fakat, run time error 91 hatası alıyorum.
Bilgine,
Alıntı:

asri tarafından gönderildi (Mesaj 895444)
Outlook da gelen mailleri takip eden bu kodlar ile farklı kurallar oluşturabilirsiniz. Mail alındığı anda otomatik olarak devreye girer.

Outlook VBA da ThisOutlookSession bölümüne kopyalayın ve makroların etkinleştirilmiş olması gerekiyor. Kaydettikten sonra outlook u kapatıp açınız.

Yapılabilecek işlemler aşağıdaki şekildedir. Örnek kodlar yazılmış durumda. Bu kod yapısı ile farklı seçenekler üretilebilir.

Outlook ile bilgisayara komutlar gönderebilirsiniz.
Mail de konu ya aşağıdaki bilgileri yazdığınızda outlook maili aldığında aşağıdak işlemleri gerçekleştirecektir.

Komut:Kilitle
Komut:Oturumu Kapat
Komut:Bilgisayarı Kapat
Komut:Yeniden Başlat
Komut:Çalıştır Notepad

Yönlendirme Kuralları
Kod içinde gönderen mail adresi ve konuda eşit ise belirlenen mail adresine gelen maili gönderme
Kod içinde gönderen mail adresi eşit ise belirlenen mail adresine gelen maili gönderme
Kod içinde gönderen alanadı eşit ise belirlenen mail adresine gelen maili gönderme

Spam mail kontrolü, Konu ve içeriğe göre mailleri taşı

Spam olabilecek kelimeleri virgül , kullanarak ekleyiniz.
yasakkelimeler = "DROPBOX,DROPBOXCONTENT,FATTURA"

Yasak alan adına göre maili taşı
Yasaklı alan adlarını virgül , kullanarak ekleyiniz.
yasakalanadlari = "spamdomain.ru,spamdomain.com"


Kod:

'Option Explicit
Public olApp As Outlook.Application
Public objNS As Outlook.NameSpace
Public tasinacak As Boolean
Public spam As Boolean
Public alicimail As String
Public mnesne As MailItem
Public WithEvents myOlItems As Outlook.Items
Private Declare PtrSafe Function LockWorkStation Lib "user32.dll" () As Long
Private Declare PtrSafe Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long

Public Sub Application_Startup()
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
  Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub myOlItems_ItemAdd(ByVal Item As Object)

  If TypeName(Item) = "MailItem" Then
    alicimail = "alicimailadresiniyazin@gmail.com"
    Set mnesne = Item
    Call spam_kurallari
    If spam Then Exit Sub
   
    Call komut_kurallari
    Call yonlendirme_kurallari
  End If
End Sub

Sub komut_kurallari()
  If mnesne.Subject = "Komut:Kilitle" Then
    Call LockWorkStation
    Exit Sub
  End If
 
  If mnesne.Subject = "Komut:Oturumu Kapat" Then
    ExitWindowsEx 4, 0
    Exit Sub
  End If
 
  If mnesne.Subject = "Komut:Bilgisayarı Kapat" Then
    ExitWindowsEx 1, 0
    Exit Sub
  End If
 
  If mnesne.Subject = "Komut:Yeniden Başlat" Then
    ExitWindowsEx 2, 0
    Exit Sub
  End If
 
  If mnesne.Subject = "Komut:Çalıştır Notepad" Then
    On Error Resume Next
    Shell ("Notepad.exe")
    On Error GoTo 0
    Exit Sub
  End If
 
End Sub

Sub yonlendirme_kurallari()
  'Gönderen mail ve konu kurallı
  If mnesne.SenderEmailAddress = "gonderenmailadresiniyazin@gamil.com" And mnesne.Subject = "Test121212" Then
    Set myForward = mnesne.Forward
    myForward.Recipients.Add alicimail
    mnesne.Subject = mnesne.Subject
    mnesne.Save
    myForward.Send
    Exit Sub
  End If
 
  'Gönderen mail kurallı
  If mnesne.SenderEmailAddress = "gonderenmailadresiniyazin@gamil.com" Then
    Set myForward = mnesne.Forward
    myForward.Recipients.Add alicimail
    mnesne.Subject = mnesne.Subject
    mnesne.Save
    myForward.Send
    Exit Sub
  End If
 
  'Gönderen alan adı kurallı
  gonderen = mnesne.SenderEmailAddress
  gonderenalanadi = Mid(gonderen, InStr(gonderen, "@") + 1, Len(gonderen))
  If gonderenalanadi = "gamil.com" Then
    Set myForward = mnesne.Forward
    myForward.Recipients.Add alicimail
    mnesne.Subject = mnesne.Subject
    mnesne.Save
    myForward.Send
    Exit Sub
  End If
 
End Sub

Sub spam_kurallari()
    spam = False

    'Spam olabilecek kelimeleri virgül , kullanarak ekleyiniz.
    yasakkelimeler = "DROPBOX,DROPBOXCONTENT,FATTURA"
   
    'Yasaklı alan adlarını virgül , kullanarak ekleyiniz.
    yasakalanadlari = "spamdomain.ru,spamdomain.com"
   
    'Konu ve içeriğe göre spam maili taşı
    veri = UCase(mnesne.Body)
    kelimeler = Split(yasakkelimeler, ",")
    For i = LBound(kelimeler) To UBound(kelimeler)
    kelime = kelimeler(i)
    If InStr(mnesne.Subject, kelime) > 0 Or InStr(veri, kelime) > 0 Then
        'Gelen kutusu içinde Deneme klasörü açılmış olmalı
        mnesne.Move objNS.GetDefaultFolder(olFolderInbox).Folders("Deneme")
        spam = True
        Exit Sub
    End If
    Next i
   
    'Yasak alan adına göre maili taşı
    gonderen = fnGetSMTPAddress(mnesne.SenderEmailAddress)
    gonderenalanadi = Mid(gonderen, InStr(gonderen, "@") + 1, Len(gonderen))
    kelimeler = Split(yasakalanadlari, ",")
     
    For i = LBound(kelimeler) To UBound(kelimeler)
    kelime = kelimeler(i)
    If gonderenalanadi = kelime Then
        'Gelen kutusu içinde Deneme klasörü açılmış olmalı
        mnesne.Move objNS.GetDefaultFolder(olFolderInbox).Folders("Deneme")
        spam = True
        Exit Sub
    End If
    Next i
   
End Sub


Public Function fnGetSMTPAddress(ExchangeMailAddress As String) As String
Dim objOutlook As Outlook.Application
Dim objMailItem As Outlook.MailItem

Set objOutlook = New Outlook.Application
Set objMailItem = objOutlook.CreateItem(0)
objMailItem.To = ExchangeMailAddress
objMailItem.Recipients.ResolveAll
On Error Resume Next
If objMailItem.Recipients.Item(1).Resolved Then
fnGetSMTPAddress = objMailItem.Recipients.Item(1).AddressEntry.GetExchangeUser.PrimarySmtpAddress
If Err.Number <> 0 Then fnGetSMTPAddress = ExchangeMailAddress
Else
fnGetSMTPAddress = ExchangeMailAddress
End If
Set objMailItem = Nothing
Set objOutlook = Nothing

End Function



asri 01-06-2017 21:14

Alıntı:

ridvanucok tarafından gönderildi (Mesaj 895546)
Üstadım merhaba,

Öncelikle eline sağlık fakat, run time error 91 hatası alıyorum.
Bilgine,

İlk mesaja VBA da tools da references da seçilmesi gerekenleri ekledim.

İlgili işlemi yapıp outlook u kapatıp açıp dener misiniz.

mustilem23 01-06-2017 21:18

Üstadım çalıştırabilir sem çok değişik alanlar için kullanacam email adından exe çalıştırma 64 bit benim pc bakalım autoit exe için deneyeceğim

asri 01-06-2017 21:21

Alıntı:

mustilem23 tarafından gönderildi (Mesaj 895561)
Üstadım çalıştırabilir sem çok değişik alanlar için kullanacam email adından exe çalıştırma 64 bit benim pc bakalım autoit exe için deneyeceğim

Benim windows da 64 bit sorun çıkarmadı.

If mnesne.Subject = "Komut:Çalıştır Notepad" Then

ile exe çalıştırabilirsiniz. Yeni komutlarda eklenebilir.

asri 01-06-2017 21:35

Güncelleme;

Outlook 64 bit ve 32 bit sürümleri için , #If VBA7 Then komutları eklendi.

ridvanucok 02-06-2017 00:46

Eline sağlık. Teşekkürler üstadım.
Alıntı:

asri tarafından gönderildi (Mesaj 895558)
İlk mesaja VBA da tools da references da seçilmesi gerekenleri ekledim.

İlgili işlemi yapıp outlook u kapatıp açıp dener misiniz.


ridvanucok 02-06-2017 16:02

1 Eklenti(ler)
Üstadım,

32 bit sistemlerde kodu çalıştırmak istediğimde ekli hatayı almaktayım.

Değerli yardımlarını rica ederim.

asri 02-06-2017 16:33

Alıntı:

ridvanucok tarafından gönderildi (Mesaj 895709)
Üstadım,

32 bit sistemlerde kodu çalıştırmak istediğimde ekli hatayı almaktayım.

Değerli yardımlarını rica ederim.

Sanırım problem 32 64 olayı değil. Ben Outlook 2010 da test ettim.
Size 2016 sürümü kullanıyorsunuz. Kod uyuşmazlığı olabilir.

asri 02-06-2017 16:36

Güncelleme V1.0 Test

* VBA kod bölümündeki özel kurallara ek olarak.
Excel özel işlemler menüsü gibi bir özellik eklendi. Henüz geliştirme aşamasında.

*Otomatik kurulum programı hazırlandı.

- Outlook özel işlemler menüsü mouse sağ tuşa eklenmesi için çalışma yapılmaktadır.


Saat 02:56

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.