Outlook için gelen emaili şartlı otomatik kural

[mustilem23]

Merhaba arkadaşlar ,

İş yerine yaşadığım bir sıkıntıdan kaynaklı outlook kuralına ihtayacım mevcut yardımcı olabilir misiniz .teşekkürler.

Şöyle bir email geldiğin de müşterilerimden otomatik bir ileti göndermek istiyorum (konuya ilişkin en kısa sürede dönüş yapılacak şeklinde bir yazı metni ile) ,sebebi müşteri email ilettim ulaştı mı şeklinde günde yaklaşık 10 telefon araması geliyor ve vakit kaybediyorum .

Lakin şöyle bir durum mevcut ....@firmaismi.com.tr kullanıcılarına bu e mail gitmeyecek şekilde bir kural oluşturabilmek mümkün müdür ,yardımcı olabilir misiniz rica etsem .

 

[AdemCan]

Merhabalar;
Microsoft'un sitesinde Outlook \ Yönetme ve düzenleme bölümünde ilgili açıklamalar var, belki işinize yarayabilir.
İlgili başlıklar;
- E-postaları otomatik olarak iletme ve yönlendirme
- Otomatik “iş yeri dışında” yanıtları gönderme
- Kuralları kullanarak e-posta iletilerini yönetme

 

[mustilem23]

ilginiz için teşekkürler . ya ben yapamıyorum yada kuralda bir hata var ekte en son denemem mevcut yardımıcı olabilir misiniz arkadaşlar.teşekkürler.

 

[Asri]

Daha önce yazdığım bir koddan düzenleme yaptım.
Test edildi.
dahildegil değişkenine uygun formatta diğer alan adlarını ekleyiniz.

Outlook VBA da Thsoutlooksession bölümüne eklenmesi kaydedilmesi ve outlook un kapanıp açılması gerekmektedir.
Her kodda yapacağınız değişiklik sonrası kaydedip outlook u kapatıp açınız.

'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
Public ekadi, ekyolu, ektarihi, ekgonderen, ekkonusu As String
Private Const kaydetklasor As String = "c:\OutlookOzel"

Dim WithEvents m_objContact As Outlook.ContactItem
Dim WithEvents m_objExpl As Outlook.Explorer
 
Private m_blnIsContactFolder As Boolean

#If VBA7 Then
     Private Declare PtrSafe Function LockWorkStation Lib "user32.dll" () As LongPtr
     Private Declare PtrSafe Function ExitWindowsEx Lib "USER32" (ByVal dwOptions As LongPtr, ByVal dwReserved As LongPtr) As LongPtr
#Else
     Private Declare Function LockWorkStation Lib "user32.dll" () As Long
     Private Declare Function ExitWindowsEx Lib "USER32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
#End If

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
     Set mnesne = Item
     call otomatik_cevap  
  End if

 End sub


Sub otomatik_cevap()
  Dim Recipients As Outlook.Recipients
  Dim Recip As Outlook.Recipient
  Set Recipients = mnesne.Recipients
  buldu = False
  For Each Recip In Recipients
    If Recip.Type = olCC Then
      If InStr(1, fnGetSMTPAddress(Recip.Address), "sizinmailadiniz@sizinalanadi.com", vbTextCompare) Then
        buldu = True
        Exit For
      End If
    End If
  Next
  
  If buldu = False Then
     gonderenmail = fnGetSMTPAddress(mnesne.SenderEmailAddress)
     gonderenalanadi = "/" & Mid(gonderenmail, InStr(gonderenmail, "@") + 1, Len(gonderenmail)) & "/"
     dahildegil = "/alanadi1.com.tr/,/alanaadi2.com/"
     If InStr(dahildegil, gonderenalanadi) <= 0 Then
       Set myForward = mnesne.Forward
       myForward.Recipients.Add gonderenmail
       myForward.Subject = mnesne.Subject
       myForward.Body = "Merhaba, konuya ilişkin en kısa sürede dönüş yapılacaktır." & myForward.Body
       myForward.Send
       Exit Sub
      End If
   End If
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

 

[mustilem23]

Üstadım ilgin için çok teşekkur ederim.
ekteki gibi bir hata alıyorum benim sistemim 64 bit ondanmı kaynaklı mıdır bu hata acaba çözüm için yardımcı olabilir misiniz rica etsem.

 

[Asri]

Üstadım ilgin için çok teşekkur ederim.
ekteki gibi bir hata alıyorum benim sistemim 64 bit ondanmı kaynaklı mıdır bu hata acaba çözüm için yardımcı olabilir misiniz rica etsem.

End Sub dan önce bir tane End if ekleyip dener misiniz


Kod outlook umda aktif kalmış. Öğlene kadar tüm maillere dönüş yapmış : ))

 

[mustilem23]

Sabah ilk iş deneyecegim üstadım .
600 kişiyi dahil değil listesine ekleyecegim inşallah kasma yapmaz outlookta , iyi düşüneyim iyi olsun.
Sormayın aynı dert benimde oldu deneme yapar iken G.M dahi gittti ???? bu gün imzaya çıktıgımda sordu test dedim olmadı 15 dakkada dönüş yapman lazım dedi olumlu olarak her konu için .anladım ki dikkate almış ...????

 

[Asri]

Sabah ilk iş deneyecegim üstadım .
600 kişiyi dahil değil listesine ekleyecegim inşallah kasma yapmaz outlookta , iyi düşüneyim iyi olsun.
Sormayın aynı dert benimde oldu deneme yapar iken G.M dahi gittti ???? bu gün imzaya çıktıgımda sordu test dedim olmadı 15 dakkada dönüş yapman lazım dedi olumlu olarak her konu için .anladım ki dikkate almış ...????

Kişi ekleyemezsiniz kod buna uygun değil, alan adı ekleyebilirsiniz ancak 600 alan adı string limitlerini zorlayabilir. Test etmedim.


Bu durumda kodun dizi değişken bazlı dahil değil listesine göre değiştirilmesi gerekiyor.

 

[mustilem23]

Üstadım tam istediğim mantık ile çalışıyor .4 gündür testte fakat durdum çünki .

adımın cc de olduğunda dahi cevap veriyor . sadece adımın kime kutusunda olduğunda cevap verebilmesi mümkünmüdür.
bir ricam daha olacak çok önemli degil ama mümkünse cevaplanan ileti düzmetin olarak iletiliyor html olarak gönderebilmesi mümkün müdür.teşekkürler.

 

[Asri]

Üstadım tam istediğim mantık ile çalışıyor .4 gündür testte fakat durdum çünki .

adımın cc de olduğunda dahi cevap veriyor . sadece adımın kime kutusunda olduğunda cevap verebilmesi mümkünmüdür.
bir ricam daha olacak çok önemli degil ama mümkünse cevaplanan ileti düzmetin olarak iletiliyor html olarak gönderebilmesi mümkün müdür.teşekkürler.

Kod güncellendi.


kodda cc de bulunmaması gereken mail adresinizi düzeltiniz.

 

[mustilem23]

Asri usta bizim Outlook tarih olacak belli oldu , web tabanlı bir email sistemine girdi şirket lakin cok fazla bir müşteri var e-mailimde otomatik cevap bir kerelik olduğu için işlevsiz kalıyor onun için bu kodlamayı kullanmaya karar verdim gelen her emaile cevap versin şirketim dışındakilere bu konuyu daha önce konuştuk eski versiyonda çalışıyordu lakin şuan ki Microsoft Office 365 ProPlus 64 bit de bir türlü çalıştıramadım ,

Şöyle yaptım Alt+f11 kodlamayı yapıştırdım kaydettim daha sonra F5 ile çalıştırdım ve outlook u açıp kapatıp tekrar açtım lakin ne bir hata nede email gönderiyor rica etsem kodlamayı kontrol edebil me şansınız mevcut mudur ?

 

[Asri]

Asri usta bizim Outlook tarih olacak belli oldu , web tabanlı bir email sistemine girdi şirket lakin cok fazla bir müşteri var e-mailimde otomatik cevap bir kerelik olduğu için işlevsiz kalıyor onun için bu kodlamayı kullanmaya karar verdim gelen her emaile cevap versin şirketim dışındakilere bu konuyu daha önce konuştuk eski versiyonda çalışıyordu lakin şuan ki Microsoft Office 365 ProPlus 64 bit de bir türlü çalıştıramadım ,

Şöyle yaptım Alt+f11 kodlamayı yapıştırdım kaydettim daha sonra F5 ile çalıştırdım ve outlook u açıp kapatıp tekrar açtım lakin ne bir hata nede email gönderiyor rica etsem kodlamayı kontrol edebil me şansınız mevcut mudur ?

Microsoft Office 365 kurulu olmadığı için bilemiyorum.
Önce outlook da basit makroları deneyebilirsiniz.

 

[mustilem23]

Üstad kullandiğım diğer makro çalısıyor e mail adresleri birleştiren bu bi türlü çalıştırmadım birde arkadaşlar ların pc de deneyeceğim.

 

[mustilem23]

Üstad Microsoft Office 365 denedik çalışıyor ,benim kurullardan kaynaklı işlem görmüyor muş .Tekrar emeğine sağlık.

 

[Asri]

Üstad Microsoft Office 365 denedik çalışıyor ,benim kurullardan kaynaklı işlem görmüyor muş .Tekrar emeğine sağlık.

Çözülmesi güzel. Çok fazla etken seçenecek var tahmin etmek zor.