Manustatud piltide automaatne ekstraktimine konkreetsetest sissetulevatest meilidest Outlook VBA kaudu

Kui soovite, et Outlook eraldaks ja salvestaks manustatud pildid konkreetsetest sissetulevatest meilidest automaatselt, vaadake seda artiklit. Siin õpetame teile, kuidas seda VBA koodi abil realiseerida.

Mõned kasutajad peavad sageli manustatud pildid konkreetsetest sissetulevatest e-kirjadest eraldama ja salvestama need teatud Windowsi kausta. Seda on iga kord käsitsi teha nii tülikas. Seetõttu ootavad paljud kiiret ja mugavat lähenemist, mis võimaldab Outlookil seda automaatselt teha. Nüüd jagame teiega sellist meetodit.

Manustatud kujutiste automaatne ekstraktimine konkreetsetest sissetulevatest meilidest

1. Esiteks käivitage Outlooki programm nagu tavaliselt.
2. Seejärel käivitage Outlook VBA redaktor nagu tavaliselt viitega t "Kuidas Outlookis VBA-koodi käivitada".
3. Hiljem kopeerige ja kleepige järgmine VBA kood projekti "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ärast seda klõpsake "Application_Startup” alamprogramm.
5. Lõpuks klõpsake selle makro käivitamiseks klahvi "F5".
6. Edaspidi salvestatakse iga kord, kui sisendkausta saabub konkreetne uus e-kiri, manustatud pildid konkreetsesse Windowsi kausta, nagu on näidatud järgmisel ekraanipildil.

Puhastage suuri lisaseadmeid regulaarselt

Soovitatav on regulaarselt oma Outlookist suuri manuseid puhastada. Selle eesmärk on hoida teie Outlooki fail sobivas suuruses. Suurem Outlooki fail on korruptsioonile vastuvõtlikum. Nagu teate, on PST kahjustustega üsna raske hästi toime tulla. Võib-olla proovite esmalt seda postkasti parandamise tööriista abil parandada. Siiski most juhtudest see ei tööta. Teie ainus abinõu on spetsialiseerunud PST remont tööriist, nagu DataNumen Outlook Repairvõi asjakohased professionaalsed taastamisteenused.

Autori sissejuhatus:

Shirley Zhang on andmete taastamise ekspert DataNumen, Inc., mis on maailmas juhtiv andmete taastamise tehnoloogiate, sealhulgas mdf parandus ja Outlooki remonditarkvaratooted. Lisateabe saamiseks külastage www.datanumenCom