Como extrair automaticamente imagens incorporadas de e-mails recebidos específicos via Outlook VBA

Se você deseja que o Outlook extraia e salve automaticamente as imagens incorporadas dos emails recebidos específicos, consulte este artigo. Aqui ensinaremos como realizá-lo com código VBA.

Alguns usuários frequentemente precisam extrair as imagens incorporadas dos e-mails recebidos específicos e salvá-los em uma determinada pasta do Windows. É tão problemático fazer isso manualmente todas as vezes. Portanto, muitos esperam aprender uma abordagem rápida e conveniente para permitir que o Outlook faça isso automaticamente. Agora, aqui vamos compartilhar esse método com você.

Extração automática de imagens incorporadas de e-mails recebidos específicos

1. Em primeiro lugar, inicie seu programa Outlook como de costume.
2. Em seguida, acione o editor VBA do Outlook como de costume com a referência t “Como executar o código VBA no seu Outlook".
3. Posteriormente, copie e cole o seguinte código VBA no projeto “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. Em seguida, clique na sub-rotina “Application_Startup”.
5. Por fim, clique na tecla “F5” para acionar esta macro.
6. A partir de agora, sempre que um novo e-mail específico chegar à caixa de entrada, as imagens incorporadas serão salvas na pasta específica do Windows, conforme mostrado na captura de tela a seguir.

Limpe anexos grandes regularmente

É aconselhável limpar anexos grandes do seu Outlook regularmente. Isso ajuda a manter o tamanho do arquivo do Outlook adequado. Arquivos grandes do Outlook são mais suscetíveis à corrupção. Como você sabe, danos em arquivos PST são bastante difíceis de serem resolvidos. Talvez você tente primeiro corrigi-los usando uma ferramenta de reparo da caixa de entrada. No entanto, na maioria dos casos, isso não funciona. Sua única opção é um serviço especializado. Reparação de PST ferramenta, como DataNumen Outlook Repair, ou serviços de recuperação profissional relevantes.

Introdução do autor:

Shirley Zhang é especialista em recuperação de dados em DataNumen, Inc., líder mundial em tecnologias de recuperação de dados, incluindo conserto de mdf e produtos de software de reparo do Outlook. Para mais informações visite www.datanumen.com