☰

Outlook VBA - 予定のメール添付ファイルを開き、送信者のメール アドレスを抽出する

tag-icon • tag-icon microsoft-outlook vba extract attachments
Outlook VBA - 予定のメール添付ファイルを開き、送信者のメール アドレスを抽出する

カレンダー (予定) エントリが 200 件以上あり、そのすべてに元の電子メール メッセージが添付ファイルとして含まれています。予定の電子メール添付ファイルから送信者の電子メール アドレスを抽出する必要があります。

MailItem オブジェクト ( ) から送信者の電子メール アドレスを抽出する方法はわかっていますMailItem.SenderEmailAddressが、電子メール メッセージが予定の添付ファイルになったときにこれらのプロパティにアクセスする方法がわかりません。AppointmentItemオブジェクトには Attachments プロパティがありますが、Attachments オブジェクトのプロパティにアクセスする方法についてはどこにも情報が見つかりません。AppointmentItem.Attachments.item(1).SenderEmailAddress を試しましたが、「オブジェクトはサポートされていません...」というメッセージが表示されました。

答え1

.msg 添付ファイルを保存し、メールアイテムとして開いて、メールアイテムのプロパティを読み取ることができます。

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant


Private Sub saveAndRetrievePropertyOfAttachedMail()

    Dim sPath As String
    
    ' the selected item may not be an AppointmentItem
    Dim oItem As Object
    
    sPath = ""
    
    Set oItem = ActiveExplorer.Selection.Item(1)
    
    If TypeName(oItem) = "AppointmentItem" Then
        Debug.Print oItem.subject
        
        ' sPath is initially blank
        ' There are risks with public variables.
        ' This is a slightly awkward way to avoid declaring sPath as a public variable
        saveAttachmentsToDriveFolder oItem, sPath
        
        returnPropertiesOfAttachmentInDriveFolder sPath
        
    End If
    
End Sub


Sub saveAttachmentsToDriveFolder(objItem, strPath)

    Dim fso As Object
    Dim fldTemp As Object
    
    Dim objAtt As Object
    Dim strFile As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' This is a default folder everyone should have.
    ' You may use another folder.
    ' Kill the files when you are done or delete manually
    Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
    Debug.Print fldTemp
    
    strPath = fldTemp.Path & "\"
    Debug.Print strPath
    
    For Each objAtt In objItem.Attachments
        strFile = strPath & objAtt.FileName
        Debug.Print strFile
        objAtt.SaveAsFile strFile
    Next
    
End Sub


Sub returnPropertiesOfAttachmentInDriveFolder(strAttachmentFolder)

Dim objFileSystem As Object
Dim objFolder As Object
Dim objFiles As Object
Dim objFile As Object
Dim objItem As Object

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strAttachmentFolder)
Set objFiles = objFolder.Files

For Each objFile In objFiles

    If objFileSystem.GetExtensionName(objFile) = "msg" Then
    
        'Open msg file
        Set objItem = Session.OpenSharedItem(objFile.Path)
        Debug.Print objItem.SenderEmailAddress

    End If
Next

End Sub

関連情報