OutlookVBAを介して特定の受信メールから埋め込み画像を自動抽出する方法

Outlookソリューション 2025 年 9 月 29 日

Outlookで特定の受信メールから埋め込み画像を自動抽出して保存する場合は、この記事を参照してください。ここでは、VBAコードでそれを実現する方法を説明します。

一部のユーザーは、特定の受信メールから埋め込み画像を抽出して、特定のWindowsフォルダーに保存する必要があることがよくあります。毎回手動で行うのはとても面倒です。したがって、多くの人は、Outlookにそれを自動的に実行させるための迅速で便利なアプローチを学ぶことを楽しみにしています。さて、ここで私たちはあなたとそのような方法を共有します。

特定の受信メールから埋め込み画像を自動抽出

まず、通常どおりOutlookプログラムを起動します。
次に、参照t "を使用して通常どおりOutlookVBAエディターをトリガーします。OutlookでVBAコードを実行する方法"
後で、次のVBAコードをコピーして「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

その後、「Application_Startup」サブルーチンをクリックしてください。
最後に、「F5」キーをクリックしてこのマクロをトリガーします。
これ以降、次のスクリーンショットに示すように、特定の新しい電子メールが受信トレイに到着するたびに、埋め込まれた画像が特定のWindowsフォルダーに保存されます。

大きな添付ファイルを定期的にクリーンアップする

Outlook から大きな添付ファイルを定期的に削除することをお勧めします。これは、Outlook ファイルのサイズを適切な状態に保つためです。Outlook ファイルが大きいほど、破損しやすくなります。ご存知のように、PST ファイルの破損は適切に対処するのが非常に困難です。おそらく、最初に受信トレイ修復ツールで修復を試みるでしょう。しかし、ほとんどの場合、うまくいきません。唯一の手段は、専門的なツールを使用することです。 PST修復のようなツール DataNumen Outlook Repair、または関連する専門的な復旧サービス。

著者紹介：

Shirley Zhangは、のデータ復旧の専門家です。 DataNumen、Inc。は、以下を含むデータ復旧技術の世界的リーダーです。 mdf修正と見通し修理ソフトウェア製品。詳細については、次のWebサイトをご覧ください。 WWW。datanumen.com