Kā automātiski iegūt iegultos attēlus no konkrētiem ienākošajiem e-pastiem, izmantojot Outlook VBA

Ja vēlaties, lai programma Outlook automātiski izvelk un saglabā iegultos attēlus no konkrētiem ienākošajiem e-pastiem, varat atsaukties uz šo rakstu. Šeit mēs iemācīsim jums to realizēt ar VBA kodu.

Dažiem lietotājiem bieži ir jāizvelk iegultie attēli no konkrētajiem ienākošajiem e-pastiem un jāsaglabā tie noteiktā Windows mapē. Manuāli to darīt katru reizi ir tik apgrūtinoši. Tādēļ daudzi ar nepacietību gaida ātru un ērtu pieeju, lai ļautu programmai Outlook automātiski to paveikt. Tagad šeit mēs dalīsimies ar jums ar šādu metodi.

Automātiski izvilkt iegultos attēlus no konkrētiem ienākošajiem e-pastiem

1. Pirmkārt, palaidiet programmu Outlook kā parasti.
2. Pēc tam aktivizējiet Outlook VBA redaktoru kā parasti ar norādi t “Kā palaist VBA kodu programmā Outlook".
3. Vēlāk nokopējiet un ielīmējiet šo VBA kodu projektā “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. Pēc tam noklikšķiniet uz apakšprogrammas “Application_Startup”.
5. Visbeidzot, noklikšķiniet uz taustiņa “F5”, lai aktivizētu šo makro.
6. Turpmāk katru reizi, kad iesūtnē ienāk konkrēts jauns e-pasts, iegultie attēli tiks saglabāti konkrētajā Windows mapē, kā parādīts nākamajā ekrānuzņēmumā.

Regulāri iztīriet lielos piederumus

Ieteicams regulāri iztīrīt lielus pielikumus no programmas Outlook. Tas ir paredzēts, lai jūsu Outlook fails būtu atbilstošā lielumā. Lielāki Outlook faili ir vairāk pakļauti bojājumiem. Kā zināms, PST failus ir diezgan grūti novērst. Iespējams, vispirms mēģināsiet tos labot, izmantojot iesūtnes labošanas rīku. Tomēr vairumā gadījumu tas nedarbosies. Vienīgā iespēja ir specializēta... PST remonts rīks, piemēram DataNumen Outlook Repairvai attiecīgie profesionālie atkopšanas pakalpojumi.

Autora ievads:

Šērlija Džana ir datu atkopšanas eksperte DataNumen, Inc., kas ir pasaules līderis datu atkopšanas tehnoloģiju, tostarp mdf labot un perspektīvas remonta programmatūras produktus. Lai iegūtu vairāk informācijas, apmeklējiet vietni www.datanumen. Ar