Soru Outlook'ta Sadece PDF Ekini Otomatik İndiren Makro?

[emdayes]

Merhaba, outlook'ta belli bir mailden gelen sadece PDF olan ekleri indirecek bir makroya ihtiyacım var. Benim yazdığım belli bir mailden gelen tüm ekleri indiriyor. Bana sadece PDF olanını indiren lazım. Yardımcı olursanız çok sevinirim.

Benim yazdığım bu makro çalışıyor, sadece PDF ekini indiren bir kod eklemem lazım araya ancak nasıl yapacağımı bilmiyorum:

Sub OutlookEkKaydet()

Dim oApp As Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oFolder As Outlook.Folder
Dim oMI As Outlook.MailItem
Dim oAttach As Outlook.Attachment
Dim i As Object

Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)

For Each i In oFolder.Items

If i.Class = olMail Then

Set oMI = i

If oMI.SenderEmailAddress = "xxx@gmail.com" Then

If oMI.Attachments.Count > 0 Then


For Each oAttach In oMI.Attachments

oAttach.SaveAsFile "C:\Users\xxx\Desktop\ekler\" & Format(oMI.ReceivedTime, "dd-mm-yyyy hh-mm-ss ") & oAttach.FileName


Next
End If
End If
End If


Next

End Sub

 

[bmutlu966]

For Each bölümünü aşağıdaki şekilde değiştirin.

If oMI.Attachments.Count > 0 Then

For Each oAttach In oMI.Attachments

    If Right(oAttach.Filename, 4) = ".pdf" Then

        oAttach.SaveAsFile "C:\Users\xxx\Desktop\ekler\" & Format(oMI.ReceivedTime, "dd-mm-yyyy hh-mm-ss ") & oAttach.Filename

    End If

Next

 

[bmutlu966]

Belki bazı .pdf dosyaları .PDF de olabilir diye aşağıdaki şekilde değiştirin.

If oMI.Attachments.Count > 0 Then

For Each oAttach In oMI.Attachments

    If Right(oAttach.Filename, 4) = ".pdf" or Right(oAttach.Filename, 4) = ".PDF" Then

        oAttach.SaveAsFile "C:\Users\xxx\Desktop\ekler\" & Format(oMI.ReceivedTime, "dd-mm-yyyy hh-mm-ss ") & oAttach.Filename

    End If

Next

 

[emdayes]

Belki bazı .pdf dosyaları .PDF de olabilir diye aşağıdaki şekilde değiştirin.

If oMI.Attachments.Count > 0 Then

For Each oAttach In oMI.Attachments

    If Right(oAttach.Filename, 4) = ".pdf" or Right(oAttach.Filename, 4) = ".PDF" Then

        oAttach.SaveAsFile "C:\Users\xxx\Desktop\ekler\" & Format(oMI.ReceivedTime, "dd-mm-yyyy hh-mm-ss ") & oAttach.Filename

    End If

Next

Çok teşekkür ederim oldu. Bu makronun çalışması için her seferinde modülü açıp F5 mi demem lazım. Yoksa kendi kendine yapması için ayrıca bir kod var mı? Veyahut modülleri açıp vba sayfası dışında nereden çalıştırabilirim?

Bir de Benim bundan sonraki aşama için istediğim bir kodun PDF dosyasını tarayıp, dosyada istediğim kelimeler/sayılar varsa bana rapor/mail göndermesi. Bunu sanırım powershell veya notepad'de bir script yazarak oluşturmam lazım. bu konu hakkında önerebileceğiniz kaynak var mı?

 

[bmutlu966]

Makronuzu çalıştırmak için Excel sayfasında insert menüsünden bir şekil ekleyebilir ve bu şeklin üstüne mouse ile sağ clik yaparak makronuzu bu şekle ekleyebilirsiniz. Bu şekle bastığınızda makronuz çalışacaktır.

 

[necati]

Merhaba,
Alternatif olarak outlook içinde de bu türden bir makro kullanabilirsiniz. Örnek olarak bir tanesi aşağıda. Default gelen klasörünü tarar. Eğer başka klasörleri de taramak istersen kod içinde açıklaması var. Bu makroyu çalıştırıp tüm mailleri taratırsınız ve ekleri kaydedersiniz, sonrasında her yeni mail için kendisi otomatik tarasın isterseniz; outlook kuralı oluşturun. Sonraki aşamalar için düşündüğünüz işlemlerle ilgili Zeki Gürsoy beyin "pdftotext" çalışması var. Onu kullanarak yapılan örnekleri inceleyiniz.
Outlookta makro çalıştırma kuralı belki sizde biraz farklı olabilir ama genel olarak şu şekilde:

* Dosya, Kural sihirbazı
* Kural sihirbazı, Konuda ... bulunan, Komut dosyası ögesi çalıştır,
* Kural açıklamasını düzenleyin kutucuğundaki komut dosyasına tıklanarak gelen ekrandan Proje1.OutlookEkKaydet seçilir. Yani bu makronun adı (OutlookEkKaydet) ve projesi (Proje1) yazılır.

Sub OutlookEkKaydet()
'Outlook ta *.doc ve *.pdf Eklentilerini kaydetmek. 
'Seçilen veya Default Klasörün tamamını tarar.

Dim oApp As Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oFolder As Outlook.folder
Dim oMI As Outlook.MailItem
Dim oAttach As Outlook.Attachment
Dim i As Object
Dim xDotPos As Integer, xFileType As String

Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)  'Default klasörü set eder
'Set oFolder = Application.Session.PickFolder  'Klasör seçmek istersen bunu aktif et yukarıdaki satırı pasif yap

For Each i In oFolder.Items

 If i.Class = olMail Then
 Set oMI = i

If oMI.SenderEmailAddress = "x@gmail.com" Then 'Gönderen kısıtlaması
 If oMI.Attachments.Count > 0 Then

    For Each oAttach In oMI.Attachments
    xDotPos = InStrRev(oAttach.DisplayName, ".")
    xFileType = Mid(oAttach.DisplayName, xDotPos, Len(oAttach.DisplayName) - xDotPos + 1)
        If xFileType = ".doc" Or xFileType = ".pdf" Then
        oAttach.SaveAsFile "C:\Users\xxx\Desktop\ekler\" & Format(oMI.ReceivedTime, "dd-mm-yyyy hh-mm-ss ") & oAttach.FileName
        End If
    Next

 End If
 End If    'Gönderen kısıtlaması sonu
 End If

Next
Set oApp = Nothing
Set oNS = Nothing
Set oFolder = Nothing
MsgBox "İşlem tamam"
End Sub

 

[emdayes]

Merhaba,
Alternatif olarak outlook içinde de bu türden bir makro kullanabilirsiniz. Örnek olarak bir tanesi aşağıda. Default gelen klasörünü tarar. Eğer başka klasörleri de taramak istersen kod içinde açıklaması var. Bu makroyu çalıştırıp tüm mailleri taratırsınız ve ekleri kaydedersiniz, sonrasında her yeni mail için kendisi otomatik tarasın isterseniz; outlook kuralı oluşturun. Sonraki aşamalar için düşündüğünüz işlemlerle ilgili Zeki Gürsoy beyin "pdftotext" çalışması var. Onu kullanarak yapılan örnekleri inceleyiniz.
Outlookta makro çalıştırma kuralı belki sizde biraz farklı olabilir ama genel olarak şu şekilde:

* Dosya, Kural sihirbazı
* Kural sihirbazı, Konuda ... bulunan, Komut dosyası ögesi çalıştır,
* Kural açıklamasını düzenleyin kutucuğundaki komut dosyasına tıklanarak gelen ekrandan Proje1.OutlookEkKaydet seçilir. Yani bu makronun adı (OutlookEkKaydet) ve projesi (Proje1) yazılır.

Sub OutlookEkKaydet()
'Outlook ta *.doc ve *.pdf Eklentilerini kaydetmek.
'Seçilen veya Default Klasörün tamamını tarar.

Dim oApp As Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oFolder As Outlook.folder
Dim oMI As Outlook.MailItem
Dim oAttach As Outlook.Attachment
Dim i As Object
Dim xDotPos As Integer, xFileType As String

Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)  'Default klasörü set eder
'Set oFolder = Application.Session.PickFolder  'Klasör seçmek istersen bunu aktif et yukarıdaki satırı pasif yap

For Each i In oFolder.Items

If i.Class = olMail Then
Set oMI = i

If oMI.SenderEmailAddress = "x@gmail.com" Then 'Gönderen kısıtlaması
If oMI.Attachments.Count > 0 Then

    For Each oAttach In oMI.Attachments
    xDotPos = InStrRev(oAttach.DisplayName, ".")
    xFileType = Mid(oAttach.DisplayName, xDotPos, Len(oAttach.DisplayName) - xDotPos + 1)
        If xFileType = ".doc" Or xFileType = ".pdf" Then
        oAttach.SaveAsFile "C:\Users\xxx\Desktop\ekler\" & Format(oMI.ReceivedTime, "dd-mm-yyyy hh-mm-ss ") & oAttach.FileName
        End If
    Next

End If
End If    'Gönderen kısıtlaması sonu
End If

Next
Set oApp = Nothing
Set oNS = Nothing
Set oFolder = Nothing
MsgBox "İşlem tamam"
End Sub

Merhaba, bende nedense " Konuda ... bulunan, Komut dosyası ögesi çalıştır" kısmı yok. Nasıl bulabilirim o kısmı? Bir yerden aktifleştirmek mi gerekiyor?

 

[necati]

Merhaba,
Size gelen iletinin konusunda belirli bir kelime, mesela "pdf" gibi geçiyorsa o kelime için gönderdiğiniz resimdeki 1. kutu tıklanıp sonraki denecek, yahut bu standart değilse belirli bir gönderenden gelen iletiler için (makronuzdaki "x@gmail.com") aynı yerdeki 2. kutu tıklanıp ilerlenecek. Yani komut dosyası kuralı ikinci aşamada belirecek.

 

[emdayes]

Merhaba,
Size gelen iletinin konusunda belirli bir kelime, mesela "pdf" gibi geçiyorsa o kelime için gönderdiğiniz resimdeki 1. kutu tıklanıp sonraki denecek, yahut bu standart değilse belirli bir gönderenden gelen iletiler için (makronuzdaki "x@gmail.com") aynı yerdeki 2. kutu tıklanıp ilerlenecek. Yani komut dosyası kuralı ikinci aşamada belirecek.

2. aşamada da göremiyorum maalesef bunu hocam.

 

[necati]

Maalesef benim versiyon da eski olduğu için birşey diyemeyeceğim.
"F1" yardım tuşunu çağırarak orada arama yapmayı deneyebilirsiniz.

 

[necati]

Tekrar merhaba, aşağıdaki linkte 2016 Outlook'ta bir güncelleme sonrasında "komut dosyası ögesini çalıştır" kuralının kaybolduğunu açıklayan bir yazı buldum. Sizin kural sihirbazı menüsünde ilgili kuralın olmayışının sebebi bu olsa gerek. Bu hatayı düzeltmek için ne yapılacağını açıklamışlar. Eğer sizin versiyonunuz da "2016 Outlook" ise denenebilir. Ancak konu "regedit" te değişikliği gerektirdiği için bir bilgisayarcı gözetiminde yapmanızı/yaptırmanızı tavsiye ederim.

https://tr.extendoffice.com/documents/outlook/4640-outlook-rule-run-a-script-missing.html