Outlookから添付ファイルをダウンロードしてExcelで開く 質問する

これにより、変数に詳細を保存するというリクエストに対応できます。

パート2

次のリクエストに移ります

1. Outlook 受信トレイの最初のメール (最新のメール) から唯一の添付ファイルをダウンロードします
2. 添付ファイルを指定されたパスのファイルに保存します (例: "C:...")
3. 添付ファイルの名前を現在の日付 + 以前のファイル名に変更します

このコード例を参照してください。Excel から Outlook に再度遅延バインディングして、未読アイテムがあるかどうかを確認し、ある場合は添付ファイルがあるかどうかをさらに確認し、ある場合は関連するフォルダーにダウンロードします。

Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\"

Sub DownloadAttachmentFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                '~~> Download the attachment
                oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                Exit For
            Next
        Else
            MsgBox "The First item doesn't have an attachment"
        End If
        Exit For
    Next
 End Sub

Const olFolderInbox As Integer = 6
'~~> Path + Filename of the email for saving
Const sEmail As String = "C:\ExportedEmail.msg"

Sub SaveFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Save the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.SaveAs sEmail, 3
        Exit For
    Next
End Sub

Const olFolderInbox As Integer = 6

Sub MarkAsUnread()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Mark 1st unread email as read
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.UnRead = False
        DoEvents
        oOlItm.Save
        Exit For
    Next
 End Sub

Sub OpenExcelFile()
    Dim wb As Workbook

    '~~> FilePath is the file that we earlier downloaded
    Set wb = Workbooks.Open(FilePath)
End Sub