Belirli Gelen E-postalardan Katıştırılmış Görüntüleri Outlook VBA Aracılığıyla Otomatik Olarak Çıkarma

Outlook'un belirli gelen e-postalardan katıştırılmış görüntüleri otomatik olarak ayıklamasını ve kaydetmesini istiyorsanız, bu makaleye başvurabilirsiniz. Burada size VBA kodu ile nasıl gerçekleştireceğinizi öğreteceğiz.

Bazı kullanıcıların sık sık belirli gelen e-postalardan katıştırılmış görüntüleri çıkarması ve bunları belirli bir Windows klasörüne kaydetmesi gerekir. Bunu her seferinde manuel olarak yapmak çok zahmetli. Bu nedenle, çoğu Outlook'un bunu otomatik olarak gerçekleştirmesine izin verecek hızlı ve kullanışlı bir yaklaşım öğrenmeyi dört gözle bekliyor. Şimdi sizlerle böyle bir yöntemi paylaşacağız.

Gömülü Resimleri Belirli Gelen E-postalardan Otomatik Çıkarın

1. İlk olarak, Outlook programınızı her zamanki gibi başlatın.
2. Ardından, Outlook VBA düzenleyicisini her zamanki gibi t " referansıyla tetikleyin.Outlook'unuzda VBA Kodunu Nasıl Çalıştırırsınız?".
3. Daha sonra aşağıdaki VBA kodunu kopyalayıp “ThisOutlookSession” projesine yapıştırın.

Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set objInboxItems = objInbox.Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Dim strWindowsFolder As String
    Dim i As Long
 
    If TypeOf Item Is MailItem Then
       Set objMail = Item
 
       'Specify the emails as per your needs
       If objMail.Importance = olImportanceHigh Then
          Set objAttachments = objMail.Attachments
 
          'Specify the windows folder
          strWindowsFolder = "E:\" & objMail.Subject & Format(Now, "yymmddhhmmss")
          MkDir (strWindowsFolder)
 
          'Save all embedded images to the folder
          For i = 1 To objAttachments.Count
              Set objAttachment = objAttachments.Item(i)
              If IsEmbedded(objAttachment) = True Then
                 objAttachment.SaveAsFile strWindowsFolder & "\" & objAttachment.FileName
              End If
          Next
      End If
    End If
End Sub

Function IsEmbedded(objCurAttachment As Outlook.Attachment) As Boolean
    Dim objPropertyAccessor As Outlook.PropertyAccessor
    Dim strProperty As String
 
    Set objPropertyAccessor = objCurAttachment.PropertyAccessor
    strProperty = objPropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E")
 
    If InStr(1, strProperty, "@") > 0 Then
       IsEmbedded = True
    Else
       IsEmbedded = False
    End If
End Function

4. Ardından, “Application_Startup” alt programına tıklayın.
5. Son olarak, bu makroyu tetiklemek için “F5” tuşuna tıklayın.
6. Bundan sonra, Gelen Kutusuna belirli bir yeni e-posta geldiğinde, katıştırılmış görüntüler, aşağıdaki ekran görüntüsünde gösterildiği gibi belirli Windows klasörüne kaydedilecektir.

Büyük Ekleri Düzenli Olarak Temizleyin

Outlook dosyanızdaki büyük ekleri düzenli olarak temizlemeniz önerilir. Bu, Outlook dosyanızın uygun boyutta kalmasını amaçlar. Daha büyük Outlook dosyaları bozulmaya daha yatkındır. Bildiğiniz gibi, PST hasarıyla başa çıkmak oldukça zordur. Belki de ilk olarak gelen kutusu onarım aracıyla düzeltmeyi denersiniz. Ancak çoğu durumda bu işe yaramaz. Tek çareniz uzmanlaşmış bir hizmettir. PST onarımı araç, gibi DataNumen Outlook Repairveya ilgili profesyonel kurtarma hizmetleri.

Yazar Tanıtımı:

Shirley Zhang, bir veri kurtarma uzmanıdır. DataNumendahil olmak üzere veri kurtarma teknolojilerinde dünya lideri olan , Inc. mdf düzeltme ve görünüm onarım yazılım ürünleri. Daha fazla bilgi için ziyaret edin www.datanumen.com