A.S.C Filtre, Grafik ve Raporlama Eklentisi

Outlook Vba Yazma
#1
Merhaba 


Outlook 2016 kullanıyorum.
Gelen kutusunda maillerimi düzenlemek için belirli klasörlere outlook kuralları ile taşıma yapıyorum.
Ama kuralların da bir sınırı varmış. Kullar çalışmıyor.
 
Yapmak istediğim şu;

gönderenin mail adresinde kisi.adi@arcelik.com.tr yer alan "@" sonra ki alan adına göre ilgili klasöre taşımasını istiyorum.
Bu taşıma işlemi için vba yazılabilir mi?



  Alıntı
Bu mesajı beğenenler:
#2
merhaba

E-posta taşıma ile alakalı bir kod buldum.
Bu kod yığını sadece belirti tarihe kadar belirli klasöre taşıma yapıyor.
Yapmak istediğim gelen kutusundaki maillerin ilgili gelen kutusu alt klasörlerine taşınması.

2.2. E-postayı belirtilen klasöre taşımak için makro
E-postamı uzun zaman önce elle sıralamaktan vazgeçtim. Şimdi tüm e-postalarımı üç aylık bir klasöre taşıyorum. Arama postaları bir masaüstü arama motoru aracılığıyla yapılır, örneğin Google masaüstü araması.
Aşağıdaki makro, seçilen bir veya daha fazla e-postayı belirtilen bir klasöre taşıyacaktır. Bu klasör mevcut olmalıdır.
Visual Basic
  1. Sub MoveSelectedMessagesToToDo()
  2.  
  3. On Error Resume Next
  4.     Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
  5.  
  6.     Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
  7.  
  8.     Set objNS = Application.GetNamespace("MAPI")
  9.  
  10.     Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
  11.  
  12.   ' MUST CHANGE THE OUTPUT FOLDER
  13.   ' Assume this is a mail folder
  14.     Set objFolder = GetFolder("10_Offline\_00_to_do")
  15.     ' In case you would like to move to a subfolder in the inbox
  16.     'Set objFolder = objInbox.Folders.Item("Done")
  17.  
  18.  
  19.     If objFolder Is Nothing Then
  20.         MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
  21.     End If
  22.  
  23.     If Application.ActiveExplorer.Selection.Count = 0 Then
  24.         'Require that this procedure be called only when a message is selected
  25.         Exit Sub
  26.     End If
  27.  
  28.  
  29.     For Each objItem In Application.ActiveExplorer.Selection
  30.         If objFolder.DefaultItemType = olMailItem Then
  31.             If objItem.Class = olMail Then
  32.                 objItem.Move objFolder
  33.             End If
  34.         End If
  35.     Next
  36.  
  37.     Set objItem = Nothing
  38.     Set objFolder = Nothing
  39.     Set objInbox = Nothing
  40.     Set objNS = Nothing
  41.  
  42. End Sub
  43.  
  44.  
  45.  
  46. Sub MoveSelectedMessagesToFolder()
  47.  
  48. On Error Resume Next
  49.     Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
  50.  
  51.     Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
  52.  
  53.     Set objNS = Application.GetNamespace("MAPI")
  54.  
  55.     Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
  56.  
  57.   ' MUST CHANGE THE OUTPUT FOLDER
  58.   ' Assume this is a mail folder
  59.     Set objFolder = GetFolder("2009\Q4")
  60.  
  61.  
  62.  
  63.     If objFolder Is Nothing Then
  64.         MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
  65.     End If
  66.  
  67.     If Application.ActiveExplorer.Selection.Count = 0 Then
  68.         MsgBox "Nothing selected", vbOKOnly + vbExclamation, "No message selected"
  69.         Exit Sub
  70.     End If
  71.  
  72.  
  73.     For Each objItem In Application.ActiveExplorer.Selection
  74.         If objFolder.DefaultItemType = olMailItem Then
  75.             If objItem.Class = olMail Then
  76.                 objItem.Move objFolder
  77.             End If
  78.         End If
  79.     Next
  80.  
  81.     Set objItem = Nothing
  82.     Set objFolder = Nothing
  83.     Set objInbox = Nothing
  84.     Set objNS = Nothing
  85.  
  86. End Sub
  87.  
  88.  
  89. Public Function GetFolder(strFolderPath As String) As MAPIFolder
  90.   ' folder path needs to be something like
  91.   '  "Public Folders\All Public Folders\Company\Sales"
  92.   Dim objApp As Outlook.Application
  93.   Dim objNS As Outlook.NameSpace
  94.   Dim colFolders As Outlook.Folders
  95.   Dim objFolder As Outlook.MAPIFolder
  96.   Dim arrFolders() As String
  97.   Dim I As Long
  98.   On Error Resume Next
  99.  
  100.   strFolderPath = Replace(strFolderPath, "/", "\")
  101.   arrFolders() = Split(strFolderPath, "\")
  102.   Set objApp = CreateObject("Outlook.Application")
  103.   Set objNS = objApp.GetNamespace("MAPI")
  104.   Set objFolder = objNS.Folders.Item(arrFolders(0))
  105.   If Not objFolder Is Nothing Then
  106.     For I = 1 To UBound(arrFolders)
  107.       Set colFolders = objFolder.Folders
  108.       Set objFolder = Nothing
  109.       Set objFolder = colFolders.Item(arrFolders(I))
  110.       If objFolder Is Nothing Then
  111.         Exit For
  112.       End If
  113.     Next
  114.   End If
  115.  
  116.   Set GetFolder = objFolder
  117.   Set colFolders = Nothing
  118.   Set objNS = Nothing
  119.   Set objApp = Nothing
  120. End Function





  Alıntı
Bu mesajı beğenenler: dsezgin
#3
Sn conquerora;
Soru, Cevap Paylasimi icin tesekkur ederim.



  Alıntı
Bu mesajı beğenenler:


Benzer Konular...
Konu: Yazar Cevaplar: Gösterim: Son Mesaj
access-sql-6 Outlook da Sistem Yönetici mesajı ozkovlu29 2 871 26-07-2017, 22:58
Son Mesaj: ozkovlu29
  OUTLOOK EXPRESS PROGRAMINDA E-POSTA HESABI TANIMLAMA gitarisyen 4 4.168 20-02-2011, 14:28
Son Mesaj: karaayhan
  Outlook Office e Hotmail hesabı eklemek. modalı 5 3.446 05-08-2010, 13:23
Son Mesaj: DeepBlue

Foruma Git:


Bu konuyu görüntüleyen kullanıcı(lar): 1 Ziyaretçi