Hogyan lehet automatikusan kivonni a beágyazott képeket bizonyos bejövő e-mailekből az Outlook VBA segítségével

Ha azt szeretné, hogy az Outlook automatikusan kibontsa és mentse a beágyazott képeket az adott bejövő e-mailekből, tekintse meg ezt a cikket. Itt megtanítjuk, hogyan valósíthatja meg VBA kóddal.

Néhány felhasználónak gyakran ki kell bontania a beágyazott képeket az adott bejövő e-mailekből, és el kell mentenie őket egy bizonyos Windows mappába. Nagyon nehézkes ezt minden alkalommal manuálisan megtenni. Ezért sokan alig várják, hogy megtanuljanak egy gyors és kényelmes módszert, amellyel az Outlook automatikusan elvégezheti ezt. Most egy ilyen módszert osztunk meg veletek.

Beágyazott képek automatikus kibontása meghatározott bejövő e-mailekből

1. Először is indítsa el az Outlook programot a szokásos módon.
2. Ezután indítsa el az Outlook VBA szerkesztőt a szokásos módon a t hivatkozássalA VBA kód futtatása az Outlookban".
3. Később másolja ki és illessze be a következő VBA-kódot a „ThisOutlookSession” projektbe.

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. Ezután kattintson az „Application_Startup” szubrutin.
5. Végül kattintson az „F5” billentyűre a makró aktiválásához.
6. Ezentúl minden alkalommal, amikor egy adott új e-mail érkezik a Beérkezett üzenetek mappába, a beágyazott képek az adott Windows mappába kerülnek, ahogy az a következő képernyőképen látható.

Rendszeresen tisztítsa meg a nagyméretű tartozékokat

Célszerű rendszeresen törölni a nagy mellékleteket az Outlookból. Célja, hogy az Outlook-fájl megfelelő méretű legyen. A nagyobb Outlook-fájlok érzékenyebbek a korrupcióra. Mint tudják, a PST-károkat meglehetősen nehéz jól kezelni. Talán először megpróbálja megjavítani a postafiók javító eszközzel. Azonban a most az esetek közül nem fog működni. Az egyetlen üdülőhely egy speciális PST javítás eszköz, pl DataNumen Outlook Repair, vagy a megfelelő szakmai helyreállítási szolgáltatások.

Szerző Bevezetés:

Shirley Zhang adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve mdf javítás és outlook javítószoftver termékek. További információért látogasson el www.datanumen.com