Cách tự động trích xuất hình ảnh nhúng từ các email đến cụ thể qua Outlook VBA

Chia sẻ ngay bây giờ:

Nếu bạn muốn Outlook tự động trích xuất và lưu các hình ảnh nhúng từ các email đến cụ thể, bạn có thể tham khảo bài viết này. Ở đây chúng tôi sẽ hướng dẫn bạn cách hiện thực hóa nó bằng mã VBA.

Một số người dùng thường xuyên cần trích xuất các hình ảnh được nhúng từ các email đến cụ thể và lưu chúng vào một thư mục Windows nhất định. Thật là rắc rối khi phải làm điều đó theo cách thủ công mỗi lần. Do đó, nhiều người mong muốn tìm hiểu một cách tiếp cận nhanh chóng và thuận tiện để Outlook tự động thực hiện điều đó. Bây giờ, ở đây chúng tôi sẽ chia sẻ một phương pháp như vậy với bạn.

Tự động trích xuất hình ảnh nhúng từ các email đến cụ thể

  1. Đầu tiên, khởi chạy chương trình Outlook của bạn như bình thường.
  2. Sau đó, kích hoạt trình soạn thảo Outlook VBA như bình thường với tham chiếu t “Cách chạy mã VBA trong Outlook của bạn".
  3. Sau đó, sao chép và dán mã VBA sau vào dự án “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

Mã VBA - Tự động trích xuất hình ảnh nhúng từ các email đến cụ thể

  1. Sau đó, nhấp vào chương trình con “Application_Startup”.
  2. Cuối cùng, nhấp vào phím “F5” để kích hoạt macro này.
  3. Từ giờ trở đi, mỗi khi có một email mới cụ thể đến Hộp thư đến, các hình ảnh được nhúng sẽ được lưu vào thư mục Windows cụ thể, như thể hiện trong ảnh chụp màn hình sau.Hình ảnh được trích xuất trong thư mục Windows

Dọn dẹp tệp đính kèm lớn thường xuyên

Bạn nên thường xuyên dọn dẹp các tệp đính kèm lớn trong Outlook của mình. Việc này nhằm mục đích giữ cho tệp Outlook của bạn có kích thước phù hợp. Tệp Outlook lớn dễ bị hỏng hơn. Như bạn đã biết, việc xử lý lỗi PST khá khó khăn. Có thể bạn sẽ thử sửa chữa bằng công cụ sửa chữa hộp thư đến trước tiên. Tuy nhiên, trong hầu hết các trường hợp, cách này sẽ không hiệu quả. Phương án duy nhất của bạn là sử dụng một phần mềm chuyên dụng. PST sửa chữa công cụ, như DataNumen Outlook Repair, hoặc các dịch vụ phục hồi chuyên nghiệp có liên quan.

Giới thiệu tác giả:

Shirley Zhang là một chuyên gia phục hồi dữ liệu trong DataNumen, Inc., công ty hàng đầu thế giới về công nghệ khôi phục dữ liệu, bao gồm sửa chữa mdf và các sản phẩm phần mềm sửa chữa triển vọng. Để biết thêm thông tin, hãy truy cập www.datanumennăm

Chia sẻ ngay bây giờ:

Được đóng lại.