Outlook gönderilen iletilerin kopyasını klasöre kopyalama şartlı olarak

[mustilem23]

İyi geceler arkadaşlar,

Outlook 2010 sürümünü kullanıyorum , forum da epey araştırma yaptım fakat benim konuma yakın bir tartışma bulamadım .

İhtiyacım gönderdiğim e postalar da konu kısmın da Y200%(y200 sonrası değişkendir y20010,11 vs) var ise belirli bir tarih aralığındaki 01/01/2017 09/02/2017 arasındaki e postaları masa üstünde bir klasöre kaydedebilmek için kod konusunda yardımcı olabilir misiniz. teşekkürler.

en yakın kod buldum fakat bu kod excele aktarabiliyor tüm gönderilenleri zamana bakmaksızın.

Option Explicit

Private lrow As Long, x As Date, oWS As Worksheet

Sub GetFromInbox()
Const olFolderDrafts = 6
Dim olApp As Object, olNS As Object
Dim oRootFldr As Object
Dim lCalcMode As Long

Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set oRootFldr = olNS.GetDefaultFolder(olFolderDrafts)
Set oWS = ActiveSheet

x = Date
lrow = 2
lCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
GetFromFolder oRootFldr
Application.Calculation = lCalcMode

Set oWS = Nothing
Set oRootFldr = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub

Private Sub GetFromFolder(oFldr As Object)
Dim oItem As Object, oSubFldr As Object

For Each oItem In oFldr.Items
Range("g1").Value = lrow
If TypeName(oItem) = "MailItem" Then
With oItem
oWS.Cells(lrow, 1).Value = .SenderEmailAddress
oWS.Cells(lrow, 2).Value = .To
oWS.Cells(lrow, 3).Value = .cc
oWS.Cells(lrow, 4).Value = .Subject
oWS.Cells(lrow, 5).Value = .receivedtime

lrow = lrow + 1
End With
End If
Next
For Each oSubFldr In oFldr.Folders
GetFromFolder oSubFldr
Next
End Sub

 

[tirEdsOuL]

Aşağıdaki konuda, sn. asri beyin 2. yorumunu inceleyiniz..

http://www.excel.web.tr/f48/outlook-konu-alanyndan-bilgi-ekme-t161559.html

 

[Asri]

Güncel bilgi sonraki mesajda.

 

[mustilem23]

Asri usta merhaba ,

Verdiğiniz kodların bulunduğu konuyu takibe almıştım fakat şuan benim amacım başkadır ,kodu denedim şirkette bir hata almıştım referansla ilgiliydi sanırım ev de Microsoft office 14 object libery işaretli bir hata almadım ,fakat gelen emailleri kaydetmedi çalıştırıyorum hiçbir şey olmuyor excelin olduğu klasöre bir email dahi getiremedim.

şuan ilk amacım
benim kullanıcım dan gönderilmiş olan örnek 01/02/2017 ile 10/02/2017 arasında y200% olan (y200% konu başlığında bazen en başta sol yada ortada yada en sağ da olabiliyor) bu şartı içeren emailleri masaüstündeki bir klasöre kopyalamak istiyorum,

ortalama ayda 2400 email gönderiliyor bunların %20 i teklif yani y200 ile başlıyor bunlar mühim bazen outlook kasıyor istediğim teklifi dahi bulamıyor yada uzun zaman sonra müşteriler yada bayiler çamura yatabilir yor yada teklif gelmedi gibi durumlar ulaşabiliyor onun için kopya almam lazım tarih aralıklı ,arama ile alabiliyorum fakat tarihe göre sıralayıp fakat 5 ay sonra alamayacağız belli .

onun için makro ile yapılabilir mi ilk amacım ?

 

[Asri]

..
benim kullanıcım dan gönderilmiş olan ..

Ben soruyu tam okumamışım. Kod gelen kutusu için çalışıyor.
Buradaki 6 yı 5 yapın. 5 Gönderilmiş öğeleri belirtir.

Set olFldr = olNS.GetDefaultFolder(6)

 

[mustilem23]

usta teşekkürler.
pazartesi ilk iş şirkette deneyeceğim sanırım outlook um da bir sorun var hiç bir sonuç alamadım.

 

[mustilem23]

Usta eline sağlık kopyalama işlemi tamam fakat kopyalanan dosyalar açılmıyor aşağıdaki gibi bir izinle ilgili bir hata yapıyor .sanırım izinle alakası yok çünkü kopyalanan dosyayı emailin içine ekledim böyle bir dosya yok diyor.yardımcı olabilir misiniz hiç rastladınız mı böyle bir hata ile.

C:\Users\mdogru\Desktop\emaıl kpyalama kalsoru\20170213-114000-FW- SANKO TEKSTİL... dosyası açılamıyor. Dosya yok, dosyayı açma iznine sahip değilsiniz ya da dosya başka bir programda açık. Dosyayı içeren klasörü sağ tıklatın, sonra da klasör üzerindeki izinlerinizi denetlemek için Özellikler'i tıklatın.

 

[Asri]

Usta eline sağlık kopyalama işlemi tamam fakat kopyalanan dosyalar açılmıyor aşağıdaki gibi bir izinle ilgili bir hata yapıyor .sanırım izinle alakası yok çünkü kopyalanan dosyayı emailin içine ekledim böyle bir dosya yok diyor.yardımcı olabilir misiniz hiç rastladınız mı böyle bir hata ile.

Buradaki kod 3 olarak değiştirildi. Dener misiniz?

İlk mesajımdaki kod güncellendi.

olMail.SaveAs yol & dosyaadi, 3

 

[mustilem23]

Usta büyüksün ,eline sağlık çok teşekkürler.
Müsaitseniz birde aynı kapsam da sadece konu başlıklarını excele alabilen tarih bazlı Y200 referanslı kodlar için yardımcı olabilmeniz mümkün müdür.

 

[Asri]

Usta büyüksün ,eline sağlık çok teşekkürler.
Müsaitseniz birde aynı kapsam da sadece konu başlıklarını excele alabilen tarih bazlı Y200 referanslı kodlar için yardımcı olabilmeniz mümkün müdür.

Aynı işlemde mail konularını excel de listeleme mi? Farklı bir durum mu?

 

[mustilem23]

Asri usta farklı bir durum ,konu takibi ve çekilen teklif sayılarını tespit için kullanacağız .dolayısı ile kaç adet teklif resmi iletilmiş bunun tespitini yapmak amaçlıdır.yardımcı olabilirseniz çok müteşekkir olurum.

 

[Asri]

Kontrol ediniz.

http://s3.dosya.tc/server10/o7jylx/tarih_aralikli_mail_getirme.zip.html

Dim baslatarih, tarih, bitirtarih As Date
Dim konuadi, konubaslik, dosyala As String
Dim Satir As Long


Sub Menu()
    Dim olApp As Object
    Dim olNS As Object
    Dim olFldr As Object
    
    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    '5=olFolderSentMail, 6=olFolderInbox
    'Set olFldr = olNS.GetDefaultFolder(6)
    Set olFldr = olNS.PickFolder
    
    baslatarih = DateValue(Cells(1, 2).Value)
    bitirtarih = DateValue(Cells(2, 2).Value)
    
    dosyala = Cells(3, 2).Value
    konubaslik = Cells(4, 2).Value
    
    Satir = 5
    Range("A6:Z10000").ClearContents
    Call RecursiveFolders(olFldr)

    
 
End Sub

Sub RecursiveFolders(olFolder As Object)
    Dim olSubFolder As Object
    Dim olMail As Object

    For Each olMail In olFolder.Items
        If InStr(olMail.SentOn, " ") > 0 Then
            tarih = DateValue(Mid(olMail.SentOn, 1, InStr(olMail.SentOn, " ") - 1))
        Else
            tarih = olMail.SentOn
        End If
        
        veri = olMail.Subject
        
        If tarih >= baslatarih And tarih <= bitirtarih And InStr(veri, konubaslik) > 0 Then
            konuadi = olMail.Subject
            Satir = Satir + 1
            Cells(Satir, 3).Value = konuadi
            Cells(Satir, 2).Value = tarih
            
            If dosyala = "Listele ve Kaydet" Then
               Call ReplaceCharsForFileName(konuadi, "-")
            
           [COLOR=Red]    yol = ActiveWorkbook.Path & "\Mailler\"
               If Dir(yol, vbDirectory) = "" Then MkDir yol[/COLOR]

               dtDate = olMail.ReceivedTime
               dosyaadi = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
                vbUseSystem) & Format(dtDate, "-hhnnss", _
                vbUseSystemDayOfWeek, vbUseSystem) & "-" & konuadi & ".msg"
    
               olMail.SaveAs yol & dosyaadi, 3
            End If
        End If
    Next
    
   ' For Each olSubFolder In olFolder.Folders
   '     Call RecursiveFolders(olSubFolder)
   ' Next olSubFolder
    
End Sub

Private Sub ReplaceCharsForFileName(sName, _
  sChr As String _
)
  sName = Replace(sName, "'", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
  konuadi = sName
End Sub

 

[mustilem23]

üstad ,

verdiğiniz kodları yeni bir excel e ekledim fakat type mismatch hatası aldım çeşitli denemeler yaptım fakat bir sonuç elde edemedim.

verdiğiniz kodları excel vba kod bölümüne yapıştırıp akabin de veri kaynağını değiştirmem yeterli değil mi,bir de tarih aralıklı alamayacakmıyız excele konu başlıklarını ,takıldım üstad yardımcı olabilir misiniz.

 

[Asri]

üstad ,

verdiğiniz kodları yeni bir excel e ekledim fakat type mismatch hatası aldım çeşitli denemeler yaptım fakat bir sonuç elde edemedim.

verdiğiniz kodları excel vba kod bölümüne yapıştırıp akabin de veri kaynağını değiştirmem yeterli değil mi,bir de tarih aralıklı alamayacakmıyız excele konu başlıklarını ,takıldım üstad yardımcı olabilir misiniz.

Dosya ve kodlar güncellendi.

 

[mustilem23]

üstad eline sağlık ,


Set olFldr = olNS.GetDefaultFolder(6) olduğunda
Aşağıdaki hatayı alıyorum .

Object doesn't support this property or method

debug da ,

If InStr(olMail.SentOn, " ") > 0 Then gösteriyor.

Set olFldr = olNS.GetDefaultFolder(5) yapınca çalışıyor tek bir eksiği var hem excele hemde dosya kopyalama istersem masa üstüne alıyor ,excelin olduğu klasörün içine alamıyor direk masa üstü .

gelen kutusundaki hatanın giderilmesi ve klasöre kopyalama için yardımcı olabilir misiniz,

Asri usta konu açılmışken bir sorum olabilir mi ? bir ışık belirdi bende outloktaki açık bir emailin içindeki yazışmalar satır ve sutnlar olacak şekilde ayrılabilmesi mümkün müdür ?

şöyleki ;servis biriminden yada argeden gelen envanter kod tanım ve adet bilgilerini ayrı sutunlara yazdırabilmek mümkün olabilir mi ?

(tespit yaptırıyoruz müşterilerin istediği parçalar için birde excele ekleyin gönderin dediğimiz de malum iyice kızarlar )

 

[mustilem23]

Üstad 1. konuya bakabilme imakanın oldumu acaba ?

2 konu için bir makro buldum fakat basit duzeyde kalıyor sizinkine benzer fakat içeriği bana hiç uygun değil ne kadar email var ise mesaj kutusundakileri sadece bir hücreye alabiliyor fakat dolayısı ile ayrıştıramıyor.

http://www.bayramdede.com/wp-content/uploads/Maillerden-Alma.xlsm

 

[Asri]

Set olFldr = olNS.GetDefaultFolder(6) olduğunda
Aşağıdaki hatayı alıyorum .
..

İlk mesajımdaki dosya ve kod güncellendi.

Programın çalışması ve kaydetmesi ile ilgili bir sorun göremedim.

Açılışta outlook klasör seçeme eklendi.
Hem listeleme hem de kaydetme eklendi.


Diğer dediğiniz konuya ayrıca bakmak lazım.

 

[mustilem23]

Üstad eline sağlık fakat gelen kutusunda arama yaptığımızda öğler de işlem yapamıyor debugda bu hat sarı görünüyor.gelen kutusundaki soruna bakabilme imkanınız varmıdır .

If InStr(olMail.SentOn, " ") > 0 Then


kod bölümünde 'Set olFldr = olNS.GetDefaultFolder(6) bu hattı 5 yaptım sonuç aynı ,


gönderilmişler tam bahsettiğpiniz gibi çalışıyor fakat kopyaladığı emailleri masa üstüne kopyalıyor resmen ekran doldu belirli klasöre kopyalatmanın imkanı var mıdır .


2 konu için haklısınız çünki ben açık olan emaili bir excele alıp işlem yapacağım dolayısı ile outlokta bir işleme gerek yok ona daha sonra haklısınız.

 

[Asri]

...gelen kutusunda arama yaptığımızda öğler de işlem yapamıyor ...

Programın hata verdiği gündeki maillere bakmak lazım. Konusu format dışı yada konusu boş yada başka bir sorun olabilir. Bunu tespit edip kodu ona göre güncellemek lazım. Dediğim gibi bende kod sorunsuz çalııyor.

gönderilmişler tam bahsettiğpiniz gibi çalışıyor fakat kopyaladığı emailleri masa üstüne kopyalıyor resmen ekran doldu belirli klasöre kopyalatmanın imkanı var mıdır .

Program kaydetme yeri olarak, excel dosyasının bulunduğu yerde Mailler klasörü olarak tanımlandı. Klasör yok ise oluşturulacaktır.

Sadece kod güncellendi.

 

[mustilem23]

Üstad ,
şirkette başka pclerde'de deneme yaptım ilk çalıştırdığımız da şu hatayı (microsoft excel başka bir uygulamamnın OLE eylemini tamamlamasını bekliyor)veriyor sonra aradan zaman geçiyor yine debug da

If InStr(olMail.SentOn, " ") > 0 Then

kullanıcı modunda kullandığımızdan kayanklı olabilir mi ? yada başka bir hata göremedim.