Cara Mengekstrak Auto Imej Tertanam dari E-mel Masuk Khusus melalui Outlook VBA

Sekiranya anda mahu Outlook mengekstrak secara automatik dan menyimpan gambar terbenam dari e-mel masuk tertentu, anda boleh merujuk artikel ini. Di sini kami akan mengajar anda bagaimana mewujudkannya dengan kod VBA.

Sebilangan pengguna sering perlu mengekstrak gambar yang disisipkan dari e-mel masuk tertentu dan menyimpannya ke folder Windows tertentu. Sangat menyusahkan untuk melakukannya secara manual setiap masa. Oleh itu, ramai yang berharap dapat mempelajari pendekatan yang cepat dan mudah untuk membolehkan Outlook melakukannya secara automatik. Sekarang, di sini kami akan berkongsi kaedah sedemikian dengan anda.

Auto Ekstrak Imej Terbenam dari E-mel Masuk Tertentu

1. Pertama, lancarkan program Outlook anda seperti biasa.
2. Kemudian, cetuskan editor Outlook VBA seperti biasa dengan rujukan t “Cara Menjalankan Kod VBA di Outlook Anda".
3. Kemudian, salin dan tampal kod VBA berikut ke dalam projek "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. Selepas itu, klik pada subrutin “Application_Startup”.
5. Akhirnya, klik kekunci "F5" untuk mencetuskan makro ini.
6. Mulai sekarang, setiap kali apabila e-mel baru masuk di Peti Masuk, gambar yang disematkan akan disimpan ke folder Windows tertentu, seperti yang ditunjukkan pada tangkapan layar berikut.

Bersihkan Lekapan Besar Secara Berkala

Adalah dinasihatkan untuk membersihkan lampiran besar daripada Outlook anda secara berkala. Ia bertujuan untuk memastikan fail Outlook anda dalam saiz yang sesuai. Fail Outlook yang lebih besar lebih mudah rosak. Seperti yang anda tahu, kerosakan PST agak sukar untuk ditangani dengan baik. Mungkin anda akan cuba membaikinya terlebih dahulu melalui alat pembaikan peti masuk. Walau bagaimanapun, dalam kebanyakan kes, ia tidak akan berjaya. Satu-satunya jalan penyelesaian anda ialah pakar Pembaikan PST alat, seperti DataNumen Outlook Repair, atau perkhidmatan pemulihan profesional yang berkaitan.

Pengenalan Pengarang:

Shirley Zhang adalah pakar pemulihan data di DataNumen, Inc., yang merupakan pemimpin dunia dalam teknologi pemulihan data, termasuk mdf betulkan dan produk perisian pembaikan prospek. Untuk maklumat lebih lanjut, lawati www.datanumen.com