outlook'ta gelen mail ekini otomatik yazdırma makrosu

murat_orh · 16 Kasım 2011

Arkadaşlar merhaba, çok çok acil çözüm bulmam gereken bir sorunumuz var.

Outlook'ta belirli bir kişiden gelen tüm maillerin ekini (büyük ihtimalle excel olacaktır) otomatikman yazdırmak istiyorum.

Örnek:
x@hotmail.com adresinden bir mail gelirse, gelen maildeki ek (ekler genelde aynı formatta) otomatik olarak yazdırılacak.

Nette çeşitli örenkler var ama tam olarak sorunu çözemedim, nasıl bir makro yazmamız gerekiyor?

Çözüm bulan arkadaşa şimdiden şükranlarımı iletiyorum.

melchiah1978 · 28 Mart 2014

bunun yolu yokmu hakkaten arkadaşlar

Korhan Ayhan · 29 Mart 2014

Kural oluşturma seçeneklerini incelemek gerekir...

Murat OSMA · 29 Mart 2014

Gelen kutusuna düşen maillerin eki varsa ve bu ekli dosyanın uzantısı "xlsx" ise eki hemen yazıcıya gönderiyor.

Kodlar Sn. Fikri Barış Yemişli'ye aittir.
Outlook kod sayfasında "thisoutlooksession" içine kopyalamanız gerekiyor.

Kod:

[FONT="Trebuchet MS"]'ptrsafe yi 64bit outlok kullandığım için deklare ettim. 32 bitlerde gerekmiyor
Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Dim Folder As Outlook.MAPIFolder
  Set Ns = Application.GetNamespace("MAPI")
  Set Folder = Ns.GetDefaultFolder(olFolderInbox)
  Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
     If TypeOf Item Is Outlook.MailItem Then
        PrintAttachments Item
    End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
  On Error Resume Next
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String

  sDirectory = "[COLOR="red"][B]c:\siparişler\[/B][/COLOR]"

  Set colAtts = oMail.Attachments

  If colAtts.Count Then
    For Each oAtt In colAtts

' Ekli dosyanın son 4 karakterine bakıyoruz
      sFileType = LCase$(Right$(oAtt.FileName, 4))

      Select Case sFileType 'baktığımız son 4 karakteri mail eklerinde kontrol ediyoruz

' kontrol edeceğimiz ekli dosya türlerini ekliyoruz._
' bana sadece "xlsx" uzantılı excel dosyaları lazım. İhtiyaca göre "pdf" "doc" eklenebilir.
      Case "[B][COLOR="red"]xlsx[/COLOR][/B]"
         sFile = sDirectory & oAtt.FileName
        oAtt.SaveAsFile sFile ' C sürücüsündeki "siparişler" dosyasına eki kaydediyoruz
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0 'keydettiğimiz eki yazdırıyoruz
      End Select
    Next
  End If
End Sub[/FONT]

mancubus · 30 Mart 2014

Murat Bey,

izninizle bir düzeltme yapayım.

kodlar MVP Michael Bauer'in.

http://www.vboffice.net/sample.html?mnu=2&lang=en&smp=3&cmd=showitem

Murat OSMA · 31 Mart 2014

Doğrudur Sn. mancubus.
Paylaştığım kodları Sn. Fikri Barış Yemişli'den gördüğüm için ben kendisinin adını verdim.

Keşke yurt dışındaki forumlarda da, sizin gibi kodların asıl sahiplerini bulup bize yönlendiren arkadaşlar olsa.

Kod yazarına da paylaşana da teşekkürler. Umarım Sn. murat_orh' un ihtiyacını karşılar.

kneehot · 20 Aralık 2020

Arkadaşlar merhaba, bana lazım olan kodu buldum ama yukarıdaki kodları xxxxx@xxxxxxxx.com adresinden gelen maillerdeki pdf eklerini yazdır şeklinde düzenleyebilirmiyiz. Her gelen pdf ekli maili değil sadece 1 adresten gelenleri yazdırmak istiyorum. Şimdiden tüm yardımlara çok teşekkürler.

kneehot · 21 Aralık 2020

Yardımcı olabilecek yok mu? Olamayacak bir şey ise yazarsanız sevinirim en azından beklemiyim.

Korhan Ayhan · 21 Aralık 2020

Yapılamayacak birşey değil. Murat beyin paylaştığı kodlara mailin kimden geldiği kontrolü eklenecek.

Korhan Ayhan · 22 Aralık 2020

Aşağıdaki gibi düzenleyip denedim olumlu sonuç aldım.

Kod içindeki aşağıdaki satıra dosyanın yedekleneceği adresi yazınız.

sDirectory = "C:\Users\Desktop\Yedek\"

Kod içindeki aşağıdaki satıra dosyanın yedekleneceği adresi yazınız.

If oMail.SenderEmailAddress = "ilgili_kişinin_mail_adresini_yazınız" Then

C++:

Option Explicit

Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Dim Folder As Outlook.MAPIFolder
    Set Ns = Application.GetNamespace("MAPI")
    Set Folder = Ns.GetDefaultFolder(olFolderInbox)
    Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        PrintAttachments Item
    End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
    On Error Resume Next
    Dim colAtts As Outlook.Attachments
    Dim oAtt As Outlook.Attachment
    Dim sFile As String
    Dim sDirectory As String
    Dim sFileType As String
   
    sDirectory = "C:\Users\Desktop\Yedek\"
   
    Set colAtts = oMail.Attachments
   
    If colAtts.Count Then
        If oMail.SenderEmailAddress = "ilgili_kişinin_mail_adresini_yazınız" Then
            For Each oAtt In colAtts
                sFileType = UCase(CreateObject("Scripting.FileSystemObject").GetExtensionName(oAtt.FileName))
                Select Case sFileType
                    Case "PDF"
                    sFile = sDirectory & oAtt.FileName
                    oAtt.SaveAsFile sFile
                    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                End Select
            Next
        End If
    End If
End Sub

kneehot · 26 Aralık 2020

Korhan Ayhan' Alıntı:

Aşağıdaki gibi düzenleyip denedim olumlu sonuç aldım.

Kod içindeki aşağıdaki satıra dosyanın yedekleneceği adresi yazınız.

sDirectory = "C:\Users\Desktop\Yedek\"

Kod içindeki aşağıdaki satıra dosyanın yedekleneceği adresi yazınız.

If oMail.SenderEmailAddress = "ilgili_kişinin_mail_adresini_yazınız" Then

C++:

Option Explicit

Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Dim Folder As Outlook.MAPIFolder
    Set Ns = Application.GetNamespace("MAPI")
    Set Folder = Ns.GetDefaultFolder(olFolderInbox)
    Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        PrintAttachments Item
    End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
    On Error Resume Next
    Dim colAtts As Outlook.Attachments
    Dim oAtt As Outlook.Attachment
    Dim sFile As String
    Dim sDirectory As String
    Dim sFileType As String
  
    sDirectory = "C:\Users\Desktop\Yedek\"
  
    Set colAtts = oMail.Attachments
  
    If colAtts.Count Then
        If oMail.SenderEmailAddress = "ilgili_kişinin_mail_adresini_yazınız" Then
            For Each oAtt In colAtts
                sFileType = UCase(CreateObject("Scripting.FileSystemObject").GetExtensionName(oAtt.FileName))
                Select Case sFileType
                    Case "PDF"
                    sFile = sDirectory & oAtt.FileName
                    oAtt.SaveAsFile sFile
                    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                End Select
            Next
        End If
    End If
End Sub

Çok teşekkür ederim kusura bakmayın biraz geç dönüş yaptım

mozcakir · 24 Şubat 2021

Merhabalar vba hakkında herhangi bir bilgim yok maalesef ilk olarak Murat OSMA'nın yazmış olduğu kodları orjinal sayfadan yani
mancubus'un gönderdiği linkten kopyaladım ancak bu sefer çalıştır dediğimde hata aldım aldığım hata ise bu kodların 32 bit de çalıştırılamaz demesiydi aldığım hataya dair bir link paylaşıyorum. hata linki: http://prnt.sc/105sr7d

sonrasında Murat OSMA nın kodlarını yapıştırdım ancak bu seferde geçersiz prosedür olarak bir hata aldım. En kısa sürede desteğinizi bekliyorum

Korhan Ayhan · 24 Şubat 2021

Bahsettiğiniz hata 64 bit sistem hatasıdır.

Görselde ki satırı aşağıdaki gibi düzenleyip deneyiniz.

Declare PtrSafe Function

mozcakir · 24 Şubat 2021

Tekrar Merhabalar cevabınız için teşekkür ederim bundan sonra ki işlem nasıl olacak çalıştır butonuna bastığımda outlook bu kodlara göre pdf eklerini yazdırmaya başlayacak mı? ayrıca alt taraf ta bulunan http://prnt.sc/105woh6 dosya ekinin son 4 hanesine göre bir filtreleme var ancak bu filtreleme sistemini benim sistemimde olmasına gerek yok orada bulunan kodu olduğu gibi silsem çalışmış olur mu?

Korhan Ayhan · 24 Şubat 2021

Murat bey mesajında prosedürün nasıl olacağını açıklamış.

Kodları uyguladıktan sonra kodun çalışması için outlookta makroları etkinleştirmeniz gerekecektir.

mozcakir · 25 Şubat 2021

Tekrar Merhabalar ayrıca alt taraf ta bulunan http://prnt.sc/105woh6 dosya ekinin son 4 hanesine göre bir filtreleme var ancak bu filtreleme sistemini benim sistemimde olmasına gerek yok orada bulunan kodu olduğu gibi silsem çalışmış olur mu?

mozcakir · 25 Şubat 2021

bir diğer sorum maile gelen pdf dosyasında 2 sayfa mevcut ben bu sayfanın her zmn 1. sayfasını yazdırmak istiyorum bu işlemi de yapabilir miyim?

Korhan Ayhan · 25 Şubat 2021

Neden dosya uzantısı filtresine gerek yok?

Size sadece pdf uzantılı dosya içeren mail mi geliyor?

mozcakir · 25 Şubat 2021

aynen sadece pdf uzantılı mail geliyo pdf çıktılarının sadece ilk sayfasını çıktı alıyoruz

mozcakir · 25 Şubat 2021

dosya uzantısı filtreleme derken murat osma nın paylaştığı kodda
' Ekli dosyanın son 4 karakterine bakıyoruz
sFileType = LCase$(Right$(oAtt.FileName, 4))

böyle bir ibare var bu ibareyi ben şu şekilde anladım örneğin 100 adet pdf eki geldi bunların sonu 4 ile biten rakamlı olanları yazdır gibi bir işlem olarak anladım

outlook'ta gelen mail ekini otomatik yazdırma makrosu

murat_orh

melchiah1978

Korhan Ayhan

Administrator

Murat OSMA

Altın Üye

mancubus

Destek Ekibi

Murat OSMA

Altın Üye

kneehot

kneehot

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

kneehot

mozcakir

Korhan Ayhan

Administrator

mozcakir

Korhan Ayhan

Administrator

mozcakir

mozcakir

Korhan Ayhan

Administrator

mozcakir

mozcakir