Как автоматически извлекать встроенные изображения из определенных входящих писем через 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_Starтуп».
5. Наконец, нажмите клавишу «F5», чтобы запустить этот макрос.
6. Отныне каждый раз, когда в папку «Входящие» поступает определенное новое электронное письмо, встроенные изображения будут сохраняться в определенной папке Windows, как показано на следующем снимке экрана.

Регулярно очищайте большие вложения

Рекомендуется регулярно удалять большие вложения из Outlook. Он направлен на то, чтобы сохранить ваш файл Outlook в соответствующем размере. Файл Outlook большего размера более подвержен повреждению. Как вы знаете, с повреждением PST довольно сложно справиться. Возможно, вы сначала попытаетесь исправить это с помощью инструмента восстановления папки «Входящие». Однако в мost случаях это не сработает. Ваш единственный курорт - специализированный ремонт PST инструмент, как DataNumen Outlook Repairили соответствующие профессиональные службы восстановления.

Об авторе:

Ширли Чжан — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая исправить мдф и программные продукты для ремонта Outlook. Для получения дополнительной информации посетите www.datanumen.com