Як автоматично витягувати вбудовані зображення із конкретних вхідних листів через Outlook VBA

Якщо ви хочете, щоб Outlook автоматично витягував та зберігав вбудовані зображення із певних вхідних листів, ви можете звернутися до цієї статті. Тут ми навчимо вас, як це реалізувати за допомогою коду VBA.

Деяким користувачам часто доводиться витягувати вбудовані зображення із певних вхідних повідомлень електронної пошти та зберігати їх у певній папці Windows. Це настільки клопітно робити це вручну щоразу. Тому багато хто з нетерпінням чекає вивчення швидкого та зручного підходу, щоб дозволити Outlook автоматично досягти цього. Тепер ми поділимося з вами таким методом.

Автоматичне вилучення вбудованих зображень із певних вхідних листів

1. По-перше, запустіть програму Outlook, як зазвичай.
2. Потім запустіть редактор Outlook VBA, як зазвичай, з посиланням t “Як запустити код VBA у своєму Outlook».
3. Пізніше скопіюйте та вставте наведений нижче код VBA в проект «ThisOutlookSession».

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. Після цього клацніть на підпрограмі «Application_Startup».
5. Нарешті, натисніть клавішу “F5”, щоб запустити цей макрос.
6. Відтепер кожного разу, коли конкретний новий електронний лист надходить у папку Вхідні, вбудовані зображення зберігатимуться у певній папці Windows, як показано на наступному скріншоті.

Регулярно чистіть великі насадки

Бажано регулярно видаляти великі вкладення з вашого Outlook. Це спрямовано на те, щоб ваш файл Outlook мав належний розмір. Більший файл Outlook більш схильний до пошкоджень. Як ви знаєте, пошкодження PST досить важко виправити. Можливо, спочатку ви спробуєте виправити це за допомогою інструмента відновлення вхідних повідомлень. Однак у більшості випадків це не спрацює. Єдиний ваш засіб – спеціалізований. Ремонт PST інструмент, як DataNumen Outlook Repair, або відповідних професійних служб відновлення.

Вступ автора:

Ширлі Чжан - експерт із відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі виправлення mdf та перспективні програмні продукти для ремонту. Для отримання додаткової інформації відвідайте WWW.datanumen.com